用VBA导入Txt文件，第一个文件正常，第二个开始错误？

amulee

我编写了一段VBA，将Txt文件批量导入Access，当数据量小的时候正常。但是当数据量一大，如下图：


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


奇怪的是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

在2003和2010中都出现这样的问题。

t小宝

代码看不出有什么问题

andymark

取消On Error 的代码,看那里出错

amulee

.Execute "insert into " & ArrTempName(i) & "(F1) select F1 from [Text;HDR=NO;DATABASE=" & sPath & "].[" & ArrFile(i) & "]"

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