如何通过VBA匹配WhatsApp导出聊天的图片文件名并插入对应图片？

问题说明 #

需通过VBA将WhatsApp导出到Word文档的聊天记录里的图片文件名替换为实际图片，但Word中的文本带有额外前缀（如“附件? ”），导致无法匹配文件夹中的纯文件名。例如Word行内容为“附件? 00000004-PHOTO-2024-10-16-15-39-21.jpg”，而文件夹中的文件名是“00000004-PHOTO-2024-10-16-15-39-21.jpg”，需解决文件名匹配与图片插入的问题。

相关截图 #

• 图片文件列表：
  
• 导出的聊天文本：
  

修改后的VBA代码 #

核心调整：

1. 调整查找规则，匹配包含.jpg的整行文本（带前缀）
2. 从匹配到的文本中提取纯图片文件名
3. 拼接图片文件夹路径，插入图片并替换原文本

Option Explicit

' 需修改此处为你的图片文件夹路径
Const IMAGE_FOLDER_PATH As String = "C:\Users\sunny\OneDrive\ruby\dispute\"

Sub ReplaceImageNamesWithActualImages()
    Dim doc As Document
    Dim findRange As Range
    Dim imgFileName As String
    Dim fullImgPath As String
    
    Set doc = ActiveDocument
    Set findRange = doc.Content
    
    ' 设置查找规则：匹配任意内容结尾为.jpg的文本（支持大小写）
    With findRange.Find
        .ClearFormatting
        .Text = "*.[jJ][pP][gG]"
        .MatchWildcards = True
        .Forward = True
        .Wrap = wdFindStop
        .MatchCase = False
    End With
    
    ' 循环查找所有匹配项
    Do While findRange.Find.Execute
        ' 提取纯图片文件名（从最后一个空格后截取）
        imgFileName = Mid(findRange.Text, InStrRev(findRange.Text, " ") + 1)
        imgFileName = cleanMyString(imgFileName)
        
        ' 拼接完整图片路径
        fullImgPath = IMAGE_FOLDER_PATH & imgFileName
        
        ' 检查文件是否存在
        If Dir(fullImgPath) <> "" Then
            ' 替换选中的文本为图片
            findRange.Select
            Selection.Delete
            Selection.InlineShapes.AddPicture _
                FileName:=fullImgPath, _
                LinkToFile:=False, _
                SaveWithDocument:=True
        Else
            Debug.Print "图片不存在：" & fullImgPath
        End If
        
        ' 重置查找范围，避免重复匹配
        Set findRange = doc.Content
        findRange.Collapse wdCollapseEnd
    Loop
    
    MsgBox "图片替换完成！", vbInformation
End Sub

Function cleanMyString(sInput As String) As String
    ' 移除首尾空格及特殊控制字符
    sInput = Trim(sInput)
    sInput = Replace(sInput, Chr(10), "")
    sInput = Replace(sInput, Chr(13), "")
    sInput = Replace(sInput, Chr(9), "")
    cleanMyString = sInput
End Function

使用说明 #

1. 修改代码中的IMAGE_FOLDER_PATH为你的图片实际存放路径
2. 打开需要处理的Word文档
3. 运行ReplaceImageNamesWithActualImages宏即可完成替换

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