繁体   English   中英

VBA列出文件夹中的所有Excel文件?

[英]Vba list all excel files in a folder?

我有以下代码,应该列出一个文件夹中的所有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文件,但仅列出了一个文件。

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

从简单的事情开始,然后使其变得越来越复杂。 以下内容对我有用,显示了该文件夹中的所有文件。 它们被打印在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

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM