Office中国论坛/Access中国论坛

标题: 用VBA导入Txt文件，第一个文件正常，第二个开始错误？ [打印本页]

作者: amulee 时间: 2010-12-18 13:24
标题: 用VBA导入Txt文件，第一个文件正常，第二个开始错误？
我编写了一段VBA，将Txt文件批量导入Access，当数据量小的时候正常。但是当数据量一大，如下图：
[attach]44404[/attach]

代码运行到第二个文件导入就会出现如下错误提示。不知道为何
[attach]44405[/attach]

奇怪的是Access数据库关闭重新打开，并导入刚才出错文件，又能正常导入，但是到第二个文件又是上述错误。

本人代码如下：
Private Sub 导入()
Dim FileCount%, sPath$
Dim ArrTempName
Dim ArrFile
With Application.FileDialog(msoFileDialogOpen)
      .Filters.Add "文本文件", "*.txt", 1
      If .Show = -1 Then
         t = Timer
         FileCount = .SelectedItems.Count
         sPath = .InitialFileName
         If FileCount < 2 Then
            MsgBox "至少选择两个以上文件"
            Exit Sub
         End If
         ReDim ArrFile(1 To FileCount)
         ReDim ArrTempName(1 To FileCount)
         For i = 1 To FileCount
            ArrFile(i) = .SelectedItems(i)
            ArrFile(i) = Mid(ArrFile(i), InStrRev(ArrFile(i), "\") + 1)
            Mid(ArrFile(i), Len(ArrFile(i)) - 3, 1) = "#"
            ArrTempName(i) = Left(ArrFile(i), Len(ArrFile(i)) - 4)
            ArrTempName(i) = Replace(ArrTempName(i), "-", "")
         Next i
      Else
         MsgBox "未选择任何文件"
         Exit Sub
      End If
End With
With CurrentDb
      For i = 1 To FileCount

         On Error Resume Next
         .Execute "Drop Table " & ArrTempName(i)
         On Error GoTo 0
         '新建表
         .Execute "Create Table " & ArrTempName(i) & " (F1 INTEGER)"
         '导入数据
         .Execute "insert into " & ArrTempName(i) & "(F1) select F1 from [Text;HDR=NO;DATABASE=" & sPath & "].[" & ArrFile(i) & "]"
      Next i
End With
MsgBox Timer - t
End Sub
请高手指点

作者: amulee 时间: 2010-12-18 13:26
在2003和2010中都出现这样的问题。

作者: t小宝 时间: 2010-12-18 14:40
代码看不出有什么问题

作者: andymark 时间: 2010-12-18 15:42
取消On Error 的代码,看那里出错

作者: amulee 时间: 2010-12-20 08:18
.Execute "insert into " & ArrTempName(i) & "(F1) select F1 from [Text;HDR=NO;DATABASE=" & sPath & "].[" & ArrFile(i) & "]"

就是这一句出错。在导入第二个文本时就会出错。

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)