VBA列出一个文件夹中的所有文件,工作50%的时间?

我正在使用下面的VBA代码来列出一个文件夹中的所有我的Excel文件。

出于某种原因,只有50%的时间是正确的。

比方说,我有一个文件夹中的12个Excel文件,然后有时只列出1个文件,然后其他所有的文件列出。

请问有人能告诉我我要去哪里?

Sub List() On Error GoTo Message ActiveSheet.DisplayPageBreaks = False Application.DisplayAlerts = False Application.ScreenUpdating = False Dim objFSO As Object Dim objFolder As Object Dim objFile As Object Dim i As Integer Dim i2 As Long Dim i3 As Long Dim j2 As Long Dim name As String Dim Txt As String 'Create an instance of the FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject") 'Get the folder object Set objFolder = objFSO.GetFolder(ThisWorkbook.Worksheets(1).Range("M4").value) i = 18 'loops through each file in the directory and prints their names and path For Each objFile In objFolder.files 'print file path Cells(i, 6) = objFile.path 'print file path Cells(i, 7) = Replace(objFile.name, ".xlsx", "") 'print file removal icon Cells(i, 30) = "Remove" 'Add Hyperlink ThisWorkbook.Worksheets(1).Hyperlinks.Add Anchor:=Cells(i, 27), Address:=objFile.path, TextToDisplay:="Open Announcement" 'Lookup contact info Cells(i, 11).Formula = "=IFERROR(INDEX(Contacts!$C:$C,MATCH(""*"" & """ & Range("G" & i).value & """ & ""*"",Contacts!$B:$B,0)),IFERROR(INDEX(Contacts!$C:$C,MATCH(""*"" & """ & Left(Range("G" & i).value, 7) & """ & ""*"",Contacts!$B:$B,0)),""""))" Cells(i, 14).Formula = "=IF(""" & Range("K" & i).value & """ = """","""",IFERROR(INDEX(Contacts!$D:$D,MATCH(""*"" & """ & Range("K" & i).value & """ & ""*"",Contacts!$C:$C,0)),""""))" Cells(i, 18).Formula = "=IF(""" & Range("K" & i).value & """ = """","""",IFERROR(INDEX(Contacts!$E:$E,MATCH(""*"" & """ & Range("K" & i).value & """ & ""*"",Contacts!$C:$C,0)),""""))" Cells(i, 23) = "=IF(K" & i & "="""",""Missing Contact! "","""")&IF(INDEX(Data!L:L,MATCH(G" & i & ",Data!F:F,0))=""TBC"",""Missing Data! "","""")&IF(U" & i & ">=DATE(2017,1,1),"""",""Check Date!"")" 'Delivery Dates Cells(i, 21).Formula = "=IFERROR(INDEX(Data!$Q:$Q,MATCH(""*"" & """ & Range("G" & i).value & """ & ""*"",Data!$F:$F,0)),IFERROR(INDEX(Data!$Q:$Q,MATCH(""*"" & """ & Left(Range("G" & i).value, 7) & """ & ""*"",Data!$F:$F,0)),""""))" Cells(i, 25) = "Sync" i = i + 1 Next objFile ThisWorkbook.Worksheets(1).Calculate Application.DisplayAlerts = True Application.ScreenUpdating = True Exit Sub Message: Application.DisplayAlerts = False Exit Sub End Sub 

尝试改变你所有的代码看起来像这样:

 Cells(i, 6) = objFile.Path 

对此:

 ThisWorkbook.Worksheets(1).Cells(i, 6) = objFile.Path 

它可能会运行得更好。 无论如何,请确保参考工作簿和工作表。

而有点偏离主题:

  1. 使用类似SmartIndent的缩进。 否则你无法理解正在发生的事情。

  2. 不要在VBA中使用integer