2017-03-21 87 views
0

我有以下代碼應該列出文件夾中的所有excel文件。Vba列出文件夾中的所有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文件,被列出的只有一個文件。

請有人能告訴我我要去哪裏嗎?

+0

你的代碼看起來很好。什麼是文件(objFolder.files.count)的數量? – Absinthe

+0

@Absinthe是20 – user7415328

+0

@ user7415328好吧,到目前爲止這麼好。你有沒有試過設置一個斷點並逐步循環 - 究竟發生了什麼,它何時退出? – Absinthe

回答

0

從簡單的事情開始,然後讓它變得越來越複雜。以下工作適合我,顯示文件夾中的所有文件。它們被打印在Visual Basic編輯器的即時窗口(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 
相關問題