VBA打开包含特定关键字的文件

我有一个文件夹，里面有一堆

.xls

文件，其中只有那些有关键字“CITIES”的文件我才感兴趣。我需要打开这些文件，收集一些信息，我面临一些问题

Sub getTheExecSummary()

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog


myPath = "C:\Users\Morpheus\Documents\Projects\Files"



myExtension = "*.xls"  'How to add the keyword?'

myFile = Dir(myPath & myExtension)


Do While Len(myFile) > 0
    'Set variable equal to opened workbook
    Set wb = Workbooks.Open(Filename:=myPath & myFile)
    Debug.Print (myFile)
    Debug.Print (wb.Name)
    ActiveSheet.Range("A1").Value = wb.Name
    'Get next file name
      myFile = Dir
Loop

End Sub 

---

我确实写了一些调试打印语句，但似乎都不起作用。我现在只想打印那些名称中有“CITIES”关键字的工作簿。

我想您需要Instr功能

If Instr(wb.Name, "CITIES") > 0 then .....

---

您可能希望使用“CITIES”或“CITIES”来排除这些字母的任何无意使用，具体取决于文件名的设置方式

我认为您需要Instr函数

If Instr(wb.Name, "CITIES") > 0 then .....

---

您可能希望使用“CITIES”或“CITIES”来排除对这些字母的任何无意使用，具体取决于文件名的设置方式。

使用通配符来标识丢失的字母：

*CITIES*.xls

或

*CITIES*.xls*

，如果您希望使用xlsx、xlsm等

Sub Test()

    Dim colFiles As Collection
    Dim vItem As Variant
    Dim wrkBk As Workbook
    Dim sPath As String

    Set colFiles = New Collection

    sPath = "C:\Users\Morpheus\Documents\Projects\Files\"
    'you could use:
    'sPath = Environ("UserProfile") & "\Documents\Projects\Files\"

    EnumerateFiles sPath, "*CITIES*.xls", colFiles

    For Each vItem In colFiles
        Set wrkBk = Workbooks.Open(vItem)
        wrkBk.Worksheets("Sheet1").Range("A1") = wrkBk.Name
    Next vItem

End Sub

Sub EnumerateFiles(ByVal sDirectory As String, _
    ByVal sFileSpec As String, _
    ByRef cCollection As Collection)

    Dim sTemp As String

    sTemp = Dir$(sDirectory & sFileSpec)
    Do While Len(sTemp) > 0
        cCollection.Add sDirectory & sTemp
        sTemp = Dir$
    Loop
End Sub

---

使用通配符标识缺少的字母：

*CITIES*.xls

或

*CITIES*.xls*

，如果您希望使用xlsx、xlsm等

Sub Test()

    Dim colFiles As Collection
    Dim vItem As Variant
    Dim wrkBk As Workbook
    Dim sPath As String

    Set colFiles = New Collection

    sPath = "C:\Users\Morpheus\Documents\Projects\Files\"
    'you could use:
    'sPath = Environ("UserProfile") & "\Documents\Projects\Files\"

    EnumerateFiles sPath, "*CITIES*.xls", colFiles

    For Each vItem In colFiles
        Set wrkBk = Workbooks.Open(vItem)
        wrkBk.Worksheets("Sheet1").Range("A1") = wrkBk.Name
    Next vItem

End Sub

Sub EnumerateFiles(ByVal sDirectory As String, _
    ByVal sFileSpec As String, _
    ByRef cCollection As Collection)

    Dim sTemp As String

    sTemp = Dir$(sDirectory & sFileSpec)
    Do While Len(sTemp) > 0
        cCollection.Add sDirectory & sTemp
        sTemp = Dir$
    Loop
End Sub