Question

VBA 在图片文件夹中，查找文件名包含A列文本的图片，并复制到指定文件夹

先交待背景
1. <图片文件夹>（源文件夹）是： D:\Dropbox\产品\jpg\，里面有很多子文件夹，分别是不同大类的产品的照片
2. <目标文件夹>是： C:\Users\Administrator\Desktop\导出的
3. <excel文件>，shee1中，A列是产品型号（比如A001），现在根据A列型号，从<源文件夹>查找图片，并复制粘贴到<目标文件夹>。
问题
如何在查询比对 <图片文件夹>（源文件夹）的时候，把子文件夹也查询？
产品型号为A001的产品，会有n多图片，图片名称为"A001 红色 12cm”,"A001 红色 15cm”,
"A001 黑色 12cm”,"A001 白色 15cm”, 那么 FilPath 是不是要加个通配符，怎么加？
导出图片的时候，有可能不同子文件夹里面，源图片名称是一样的，导出的时候有可能被替换掉，为了避免这种情况，怎么文件名加个序号？
谢谢！
---------
Sub 导出图片()
'先清空目标文件夹 Filename = Dir("C:\Users\Administrator\Desktop\导出的\*.jpg") Do While Filename <> "" Kill "C:\Users\Administrator\Desktop\导出的\" & Filename Filename = Dir Loop
'下面开始查找和复制图片Application.ScreenUpdating = False Dim y As Integer 'y是行 Dim FilPath As String ’这个是图片所在的父文件夹 Dim newfilepath As String '图片要复制到这里 Dim rng As Range Dim s As String With Sheet1 '选择目标sheet For y = 2 To 10 '从第2行到10行 FilPath = "D:\Dropbox\产品\jpg\" & .Cells(y, 1).Text & ".jpg" '（问题1，我不知道如何把子文件夹也包含进去） If Dir(FilPath) <> "" Then newfilepath = "C:\Users\Administrator\Desktop\导出的\" & .Cells(y, 1).Text & ".jpg" FileCopy FilPath, newfilepath '开始复制图片 Else s = s & Chr(10) & .Cells(y, 1).Text '换行 End If
Next .Cells(1, 1).Select End With Application.ScreenUpdating = FalseEnd Sub
代码贴上来就没有行了，听说得上传才行，我LV5了没有权限吗？只好截图了

Answer 1

Sub 导出图片()
    '先清空目标文件夹
    
    Dim Filename As String
    Shell "cmd /c ""del  /s/q C:\Users\Administrator\Desktop\导出的\*.jpg"""    '用DOS命令删除输出文件夹下（包含子文件夹，但不删除子文件夹）的所有jpg文件
    Application.ScreenUpdating = False
    Dim y As Integer 'y是行
    Dim FilPath As String '这个是图片所在的父文件夹
    Dim newfilepath As String '图片要复制到这里
    Dim rng As Range
    Dim s As String
    
    With Sheet1 '选择目标sheet
        For y = 2 To 10 '从第2行到10行
            FilPath = """D:\Dropbox\产品\jpg\" & .Cells(y, 1).Text & "*.jpg"""
             '用XCOPY命令，复制满足条件的文件包含子文件夹，同时也会在目标文件夹中建立相同的子文件夹
            'FilePath中使用了通配符，假如 产品是：A001，则可以复制"A001 红色 12cm”,"A001 红色 15cm”,"A001 黑色 12cm”,"A001 白色 15cm”,
            Shell "cmd /c ""xcopy /s/y " & FilPath & " C:\Users\Administrator\Desktop\导出的\"""
        Next
        .Cells(1, 1).Select
    End With
    Application.ScreenUpdating = False
End Sub

追问

　　非常感谢你，不过现在把所有的图片都导出来了，
　　我研究了一下，是因为把“空”也作为对象了，
　　所以在14行上面加上判断 If Cells(y, 1) "" Then 即可 （END if就不赘述了）