首页 > 解决方案 > 访问代码导致程序锁定且无响应?

问题描述

我从不同的网站复制了这段代码,试图帮助我一次导入多个文本文件。我将文件路径、文本规范和表格更改为我需要的。现在每次我尝试运行它都会被锁定并且没有响应。

文本文件过多或数据过多是否存在问题?为什么它会导致我的程序锁定?

Public Sub WorkedAlertsImport()
On Error GoTo bImportFiles_Click_Err

Dim objFS As Object, objFolder As Object
Dim objFiles As Object, objF1 As Object
Dim strFolderPath As String

strFolderPath = "C:\Import TXT files\"
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(strFolderPath)
Set objFiles = objFolder.files

For Each objF1 In objFiles
    If Right(objF1.Name, 3) = "txt" Then
        DoCmd.TransferText acImportDelim, "TextImportSpecs", "tblImportedFiles", strFolderPath & objF1.Name, False
        Name strFolderPath & objF1.Name As "C:\Import TXT files\" & objF1.Name 'Move the files to the archive folder
    End If
Next

Set objF1 = Nothing
Set objFiles = Nothing
Set objFolder = Nothing
Set objFS = Nothing

bImportFiles_Click_Exit:
Exit Sub

bImportFiles_Click_Err:
MsgBox Err.Number & " " & Err.Description
Resume bImportFiles_Click_Exit

End Sub

标签: vbams-access

解决方案


在粗略查看您的代码后,我看不出它会导致 MS Access 锁定的原因,这通常是由执行一个从未满足终止条件的循环的代码引起的(但是,一个For Each循环正在迭代一组固定的数据,因此将始终终止)。

我会注意到以下行是多余的:

Name strFolderPath & objF1.Name As "C:\Import TXT files\" & objF1.Name

从前面的代码中您定义strFolderPath为:

strFolderPath = "C:\Import TXT files\"

因此,您将文件重命名为自身。

该代码还天真地测试了文件名的最后三个字符,如果您遇到没有扩展名的文件,这可能不一定会产生扩展名。


可以在不使用 FSO 和完全不使用if语句的情况下编写代码,因为 VBA 提供了Dir作为标准的函数来迭代目录中特定类型的文件,例如:

Sub test()
    Dim strDir As String: strDir = "C:\Import TXT files"
    Dim strTxt As String: strTxt = Dir(strDir & "\*.txt")

    Do Until strTxt = vbNullString
        DoCmd.TransferText acImportDelim, "TextImportSpecs", "tblImportedFiles", strDir & "\" & strTxt, False
        strTxt = Dir
    Loop
End Sub

推荐阅读