VbaはすべてのExcelファイルをフォルダに一覧表示しますか？

Question

私は、フォルダ内のすべての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 
ThisWorkbook.Worksheets(1).Cells(i, 6) = objFile.path 

'print file path 
ThisWorkbook.Worksheets(1).Cells(i, 7) = Replace(objFile.name, ".xlsx", "") 

'print file removal icon 
ThisWorkbook.Worksheets(1).Cells(i, 30) = "Remove" 

'Add Hyperlink 
ThisWorkbook.Worksheets(1).Hyperlinks.Add Anchor:=Cells(i, 27), Address:=objFile.path, TextToDisplay:="Open Announcement" 





'Lookup contact info 

ThisWorkbook.Worksheets(1).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)),""""))" 
ThisWorkbook.Worksheets(1).Cells(i, 14).Formula = "=IF(""" & Range("K" & i).value & """ = """","""",IFERROR(INDEX(Contacts!$D:$D,MATCH(""*"" & """ & Range("K" & i).value & """ & ""*"",Contacts!$C:$C,0)),""""))" 
ThisWorkbook.Worksheets(1).Cells(i, 18).Formula = "=IF(""" & Range("K" & i).value & """ = """","""",IFERROR(INDEX(Contacts!$E:$E,MATCH(""*"" & """ & Range("K" & i).value & """ & ""*"",Contacts!$C:$C,0)),""""))" 
ThisWorkbook.Worksheets(1).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 
ThisWorkbook.Worksheets(1).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)),""""))" 


ThisWorkbook.Worksheets(1).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 

、複数のExcelファイルがフォルダ内に存在しているにもかかわらず、唯一のファイルがリストされています。

私が間違っている場所を誰かに見せてもらえますか？

Answer 1

単純なものから始めて、さらに複雑にする。私のために、フォルダにあるすべてのファイルを表示する次の作品。これらは、Visual Basic Editorの直接ウィンドウ（Ctrl + G）に印刷されます。そこから、あなたはさらに行くことができます：

Option Explicit 

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 Long 
    Dim i2    As Long 
    Dim i3    As Long 
    Dim j2    As Long 
    Dim name   As String 
    Dim Txt    As String 

    Set objFSO = CreateObject("Scripting.FileSystemObject") 
    Set objFolder = objFSO.GetFolder("C:\Users\TestMe\Arch") 

    For Each objFile In objFolder.Files 
     Debug.Print objFile 
    Next objFile 

    Application.DisplayAlerts = True 
    Application.ScreenUpdating = True 

    Exit Sub 
Message: 

    Application.DisplayAlerts = False 
    Exit Sub 
End Sub