VBA循环批量将文件夹图片插入Word模板的需求及代码优化

没问题，我帮你把这个单张图片的宏改成批量处理版本，实现遍历指定文件夹里的所有图片，每张图片都单独插入模板并保存为新文档。下面是完整的修改代码，我会顺便解释核心改动点：

Sub Batch_Insert_Images_To_Word()
    Dim WordApp As Word.Application
    Dim WordDoc As Word.Document
    Dim imageFolderPath As String
    Dim templatePath As String
    Dim saveFolderPath As String
    Dim imageFileName As String
    Dim newDocName As String
    
    ' ---------------------- 请根据你的实际路径修改以下变量 ----------------------
    imageFolderPath = "C:\MesImages\" ' 存放图片的文件夹路径
    templatePath = "C:\Template_Files.docx" ' Word模板文件路径
    saveFolderPath = "C:\Generated_Documents\" ' 生成的新文档保存路径
    ' -------------------------------------------------------------------------
    
    ' 创建保存文件夹（如果不存在）
    If Dir(saveFolderPath, vbDirectory) = "" Then
        MkDir saveFolderPath
    End If
    
    ' 初始化Word应用
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = False ' 后台运行，处理完再显示（可以改成True看过程）
    
    ' 遍历图片文件夹里的所有图片文件（支持png/jpg/jpeg/bmp，可自行添加格式）
    imageFileName = Dir(imageFolderPath & "*.*", vbNormal)
    Do While imageFileName <> ""
        ' 判断是否为图片格式
        Select Case LCase(Right(imageFileName, 4))
            Case ".png", ".jpg", ".bmp"
                ' 匹配到图片，开始处理
                On Error Resume Next ' 捕获单个图片的错误，不终止整个批量处理
                Set WordDoc = WordApp.Documents.Open(templatePath)
                
                ' 插入当前图片
                WordDoc.InlineShapes.AddPicture Filename:=imageFolderPath & imageFileName
                ' 将嵌入式图片转为浮动式并置于文字上方
                With WordDoc.InlineShapes(1)
                    .ConvertToShape
                End With
                With WordDoc.Shapes(1)
                    .ZOrder msoBringInFrontOfText
                End With
                
                ' 生成新文档的文件名（用图片名替换后缀为docx）
                newDocName = saveFolderPath & Left(imageFileName, Len(imageFileName) - 4) & ".docx"
                ' 保存新文档
                WordDoc.SaveAs2 Filename:=newDocName, FileFormat:=wdFormatXMLDocument
                ' 关闭当前文档
                WordDoc.Close False
                Set WordDoc = Nothing
                On Error GoTo 0
                
                Debug.Print "已处理并保存：" & newDocName ' 调试信息，可删除
            Case Else
                ' 非图片文件，跳过
        End Select
        
        ' 获取下一个文件名
        imageFileName = Dir
    Loop
    
    ' 处理完成后显示Word（如果之前设为False）
    WordApp.Visible = True
    MsgBox "批量处理完成！所有文档已保存至：" & saveFolderPath, vbInformation
    
    ' 释放对象
    Set WordDoc = Nothing
    Set WordApp = Nothing
End Sub

核心改动说明： #

1. 路径配置区：把固定路径改成可配置的变量，方便你修改成自己的实际路径，还自动创建保存文件夹（避免路径不存在报错）
2. 批量遍历逻辑：用Dir函数循环读取图片文件夹里的文件，通过后缀判断筛选图片格式，确保只处理图片文件
3. 循环处理流程：每次循环都重新打开模板、插入当前图片、保存为新文档（用图片名命名）、关闭文档，完全符合你要的流程
4. 错误处理优化：添加了On Error Resume Next，就算某张图片处理失败，整个批量任务也会继续执行下去，不会中途中断
5. 后台运行：默认把Word设为不可见（Visible = False），处理完再显示，避免频繁弹窗干扰，你也可以改成True实时查看处理过程

使用注意事项： #

• 请确保模板文件路径、图片文件夹路径、保存路径都正确，路径末尾要加\
• 如果需要支持更多图片格式，比如.gif，可以在Select Case里添加对应的后缀
• 运行宏前最好先备份模板文件和图片，避免意外情况

内容的提问来源于stack exchange，提问作者Brodyeva