У меня есть папка с кучей файлов .xls, из которых меня интересуют только те, которые содержат КЛЮЧЕВОЕ слово "ГОРОДА". Мне нужно открыть эти файлы и собрать некоторую информацию, но я столкнулся с некоторыми проблемами.

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 

Я написал несколько операторов Debug.Print, ни один из которых не работает. На данный момент я хочу распечатать только те книги, в названии которых есть ключевое слово «ГОРОДА».

0
Morpheus 3 Янв 2018 в 19:45

2 ответа

Лучший ответ

Я думаю, что вам нужна функция Instr.

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

Вы можете использовать "CITIES" или "CITIES", чтобы исключить любое непреднамеренное использование этих букв, в зависимости от того, как задано имя файла.

2
Jpad Solutions 3 Янв 2018 в 16:55

Используйте подстановочный знак для определения пропущенных букв: *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
0
Darren Bartrup-Cook 3 Янв 2018 в 17:05