更新VBA代码以查找部分文件名而不是确切文件名

时间:2019-05-16 22:03:53

标签: excel vba

我有以下代码,当您查找确切的文件名时效果很好。但是,我只想引用特定单元格中的部分文件名。

我尝试了无数种不同类型的代码,但无济于事。

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

1 个答案:

答案 0 :(得分:0)

您将不得不使用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