Обновите код VBA, чтобы искать частичное имя файла вместо точного имени файла

Question

У меня есть следующий код, который хорошо работает, когда вы ищете точное имя файла.Однако я хотел бы сослаться только на частичное имя файла в конкретной ячейке.

Я пробовал множество разных типов кода безрезультатно.

Sub copyfiles()
    Dim xRg As Range, xCell As Range
    Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
    Dim xSPathStr As Variant, xDPathStr As Variant
    Dim xVal As String
    On Error Resume Next
    Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xSFileDlg.Title = "Please select the original folder:"
    If xSFileDlg.Show <> -1 Then Exit Sub
    xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
    Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xDFileDlg.Title = "Please select the destination folder:"
    If xDFileDlg.Show <> -1 Then Exit Sub
    xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
    For Each xCell In xRg
        xVal = xCell.Value
        If TypeName(xVal) = "String" And xVal <> "" Then
            FileCopy xSPathStr & xVal, xDPathStr & xVal
        End If
    Next
End Sub

Answer 1

Вам придется использовать Dir. Dir возвращает все, что найдено в папке, и вы можете использовать подстановочный знак. Используйте переменную Variant, чтобы она могла превратиться в массив, если в указанной строке найдено несколько файлов. Зациклить все файлы и все готово.

Dim listFiles As Variant
Dim fileName as String
fileName = Range("A2").Value
listFiles = Dir("E:\Folder\*" & fileName & "*")
Do While Len(listFiles) > 0
    'File Path
    MsgBox listFiles
    'Next File
    listFiles = Dir
Loop