批量插入多个文件夹标题并把对应文件夹内图片放到标题下的vba代码

在VBA中批量处理Excel工作簿，并将特定文件夹内的图片移动到相应的标题下，可以使用`Shell`函数结合循环来完成。以下是一个简单的示例，假设我们有一个包含文件夹路径的列表（例如在A列），并且每个文件夹里都有对应的图片，图片名称与文件夹标题相同：

Sub MoveImagesToFolders()
    Dim folders As Variant '存储文件夹路径
    Dim ws As Worksheet '假设在Sheet1工作表
    Set ws = ThisWorkbook.Sheets("Sheet1") '设置工作表
    folders = ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row) '获取文件夹路径范围

    For Each folder In folders '遍历每一个文件夹路径
        Dim folderPath As String
        folderPath = folder.Value '提取文件夹路径
        Dim imgName As String '假设图片名称与文件夹标题相同
        imgName = Dir(folderPath & "\" & LCase(folder.Path)) '获取文件夹里的第一个文件（如果存在）

        If imgName <> "" Then '如果找到图片
            Dim destFolder As String
            destFolder = ws.Cells(rowNumber, 2).Value '& "\" & imgName '构建目标图片路径
            Dim shellCmd As String
            shellCmd = "move """ & folderPath & "\" & imgName & """ """ & destFolder & """"
            Shell shellCmd '执行命令移动图片
            rowNumber = rowNumber + 1 '更新行号继续处理下一个文件夹
        End If
    Next folder

    MsgBox "所有图片已移入相应文件夹", vbInformation
End Sub

注意：这个脚本假设图片都在文件夹的第一层，并且图片名与文件夹标题一致。如果有其他情况，比如图片位于子目录或文件名不匹配标题，需要做适当的修改。