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

【问题标题】：Search for a file in folders and sub folders using file name if found copy to another folder in vba macros如果找到复制到 vba 宏中的另一个文件夹，则使用文件名在文件夹和子文件夹中搜索文件
【发布时间】：2019-02-20 14:18:44
【问题描述】：

使用文件名在文件夹和子文件夹中搜索文件，如果找到复制到 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

【问题讨论】：

目标路径下的文件夹都存在吗？
抱歉，您要的是目标路径，目标路径中只有一个文件夹
您确定要检查的文件名以编号 566978结尾吗？
文件夹和子文件夹中的文件比较多，我需要找一些以6位数字开头的pdf文件，后跟_PTA，例如123456_PTA.pdf,123456_AOP.pdf,123456_HUD27011.pdf ，我需要这些文件，但每个搜索的数量可能会有所不同。但是数字后面的名字是我上面提到的，那是我按数字搜索的原因。
有很多文件，但我只需要 3 个以 6 位数开头的文件，例如 123456_PTA.pdf,123456_AOP.pdf,123456_HUD27011.pdf 但有很多文件有这个数字但我需要只有这些文件要复制到目标文件夹中。谢谢你的帮助

标签： excel vba

【解决方案1】：

您正在使用 Right-function 搜索数字，但这没有考虑到它后面的文件扩展名。您可以尝试类似（假设扩展名相同）：

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

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

或者，您可以使用而不是 Right-function 来检查您要查找的数字是否出现在文件名中：

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

这只会在数字字符串较长的文件中引起问题，因为例如您可能有一个名为“123556978123.pdf”的文件，这将是误报。

【讨论】：

文件夹和子文件夹中的文件比较多，我需要找一些以6位数字开头的pdf文件，后跟_PTA，例如123456_PTA.pdf,123456_AOP.pdf,123456_HUD27011.pdf ，我需要这些文件，但每个搜索的数量可能会有所不同。但是数字后面的名字是我上面提到的，我按数字搜索的原因
正在搜索带数字的pdf文件
@DESA 如果您正在查看的文件名中始终最多 6 位数字，您可以使用： If InStr(1, fsofile, "566978") -1 Then跨度>
@DESA 我编辑了我的原始答案以包含 InStr 选项。看看吧。
我编辑了该行，但它会将子文件夹中的所有可用文件复制到目标

【解决方案2】：

这是我找到的答案
子 copy_files_from_subfolders()
将 fso 调暗为对象暗淡作为对象将 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

【讨论】：

但他的问题是它只检查子文件夹的级别，任何人都可以告诉如何在所有子文件夹中搜索，即 mainfolder->subfolder->subfolder 这样的。