VBA列出文件夹中的所有文件,50%的时间都可以使用?

时间:2017-03-08 12:49:18

标签: excel vba

我使用以下VBA代码列出文件夹中的所有Excel文件。

出于某种原因,这只能在50%的时间内正确运行。

假设我在一个文件夹中有12个excel文件,有时只列出一个文件,然后列出所有文件。

请问有人能告诉我哪里出错了吗?

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

1 个答案:

答案 0 :(得分:0)

尝试更改所有代码,如下所示:

Cells(i, 6) = objFile.Path

到此:

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

它会运行得更好。 Anyhow, make sure to refer the workbook and the worksheet.

有点偏离主题:

  1. 使用类似SmartIndent的内容进行缩进。你无法理解发生了什么。

  2. Do not use integer in VBA