Поиск в нескольких файлах с выражением "НРАВИТСЯ"

#excel #vba

Вопрос:

в диапазоне A1:A2 я сохранил имя файла. Файлы хранятся в трех разных папках.

И имя файла начинается с критериев поиска в A1, но не всегда соответствует 100 %.

A1 = «тест1»

Но документы pdf, которые я ищу, называют

«тест1-е»

, но это то, что мне нужно.

После нахождения правильного pdf-файла в трех папках мне нужно скопировать его в исходный путь.

Мой подход выглядит так:

 Sub copyFile()
  Dim objFSO As Object, rng As Range
  
  
  Dim strFileToCopy, strOldPath As String, strOldPath2 As String, strOldPath3 As String, strNewPath As String
  
  strOldPath = "" 'Verzeichnis Nr. 1 in dem die Datei liegt
  strOldPath2 = ""                                             'Verzeichnis Nr. 2 in dem die Datei liegt
  strOldPath3 = ""                                              'Verzeichnis Nr. 3 in dem die Datei liegt
  
  
  strNewPath = ""
  
  With ActiveSheet
  
  For Each rng In Range("A1:A2")
    'strFileToCopy = .Range("A2") 'Zelle mit dem Namen
    
    
    If strFileToCopy Like rng Then
    
        strFileToCopy = rng
    
        strFileToCopy = strFileToCopy amp; ".pdf" 'Suffix anhängen
    
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        OldPath = objFSO.BuildPath(strOldPath, strFileToCopy)
        If objFSO.FileExists(OldPath) Then
        objFSO.copyFile OldPath, objFSO.BuildPath(strNewPath, strFileToCopy)
    End If

    End If

Next
    
    
    'If Dir(strOldPath amp; strFileToCopy, vbNormal) <> "" Then
     ' Set objFSO = CreateObject("Scripting.FileSystemObject")
      'objFSO.copyFile strOldPath amp; strFileToCopy, strNewPath amp; strFileToCopy
    'End If
    
    
    
  End With
  
  Set objFSO = Nothing
End Sub

Но моя проблема в том, как можно выполнять поиск в разных папках и как я могу выполнять поиск с помощью «Выражения подобия», потому что мое решение не сработало. Большое спасибо за поддержку.

1.Посмотрите на сценарий.файловые системыобъекты помогают. Он покажет вам, как использовать папки и файлы, чтобы вы могли сказать .....if right(fl.name,4)="test" then.... docs.microsoft.com/en-us/office/vba/language/reference/… и docs.microsoft.com/en-us/office/vba/language/reference/…

2. f = Dir(strOldPath amp; "*" amp; rng.Value amp; "*") будет выполнен поиск по подстановочным strOldPath знакам для частичного имени rng файла . Примечание. Вам нужно убедиться, что ваши пути имеют завершающий «»

3. @TimWilliams большое спасибо. как объявить f? это какой-то Объект? Тусклый f как объект?

4. Dir возвращает строку, поэтому объявите f как строку

Ответ №1:

Что-то в этом роде я бы использовал. Это возвращает массив файлов.

 Function ReturnFiles(strSourceFolder As String, strSearch As String) As Scripting.File()

Dim a() As File
Dim fso As Scripting.FileSystemObject
Dim f As Scripting.Folder
Dim fl As Scripting.File

On Error GoTo eHandle

Set fso = New Scripting.FileSystemObject

If fso.FolderExists(strSourceFolder) Then

    Set f = fso.GetFolder(strSourceFolder)
    
    For Each fl In f.Files
        If Left(fl.Name, Len(strSearch)) = strSearch Then           '   Or instr here for example
            Set a(UBound(a)) = fl
            ReDim Preserve a(UBound(a)   1)
        End If
    Next fl

Else

End If

ReturnFiles = a

HouseKeeping:

Set fl = Nothing
Set f = Nothing
Set fso = Nothing
Erase a

Exit Function

eHandle:

    If Err.Number = 9 Then
        ReDim a(0)
        Resume
    Else
        GoTo HouseKeeping
    End If

End Function