Question

如果找到文件复制到vba宏中的另一个文件夹，请使用文件名在文件夹和子文件夹中搜索文件代码没有显示错误，但是文件不是从文件夹复制的，我需要遍历子文件夹并找到文件。

Sub copy_files_from_subfolders()    
    Dim fso As Object
    Dim fld As Object
    Dim fsofile As Object
    Dim fsofol As Object

    sourcepath = "FINAL CUT\"
    destinationpath = "Desa\MECA\"

    If Right(sourcepath, 1) <> "\" Then
    sourcepath = sourcepath & "\"
    End If

    Set fso = CreateObject("scripting.filesystemobject")
    Set fld = fso.GetFolder(sourcepath)
    If fso.FolderExists(fld) Then
        For Each fsofol In fso.GetFolder(sourcepath).SubFolders
            For Each fsofile In fsofol.Files
                If Right(fsofile, 6) = 566978 Then
                fsofile.Copy destinationpath
            End If
            Next
        Next
    End If
End Sub

Answer 1

您正在使用“右键”功能搜索该号码，但这没有考虑其后的文件扩展名。您可以尝试类似的方法（假设扩展名相同）：

Right(fsofile, 10) = "566978.txt" ''change extension to whatever

如果文件扩展名的长度不同，则可以确定点在名称中的位置并使用Mid函数。

或者，您可以使用而不是右键功能来检查要查找的数字是否出现在文件名中

If InStr(1, fsofile, "566978") <> 0 then

这仅在存在带有较长数字字符串的文件时才引起问题，因为例如您可能有一个名为“ 123556978123.pdf”的文件，这肯定是错误的。

Answer 2

这是我找到的答案
子copy_files_from_subfolders（）
暗淡作为对象 Dim fld作为对象昏暗的fsofile作为对象昏暗的fsofol作为对象

    sourcepath = "FINAL CUT\"
    destinationpath = "Desa\MECA\"

    If Right(sourcepath, 1) <> "\" Then
    sourcepath = sourcepath & "\"
    End If

    Set fso = CreateObject("scripting.filesystemobject")
    Set fld = fso.GetFolder(sourcepath)
    If fso.FolderExists(fld) Then
        For Each fsofol In fso.GetFolder(sourcepath).SubFolders
            For Each fsofile In fsofol.Files
                If InStr(1, fsofile.Name, 566978 & "_PTA") = 1 Then
            fsofile.Copy destinationpath
            End If
            Next
        Next
    End If
End Sub

如果找到文件复制到vba宏中的另一个文件夹，请使用文件名在文件夹和子文件夹中搜索文件

2 个答案: