使用VBA复制/粘贴多张图片(Excel到Outlook)

Sub CopyPasteImages()
    Dim olApp As Object
    Dim olMail As Object
    Dim olInspector As Object
    Dim olSelection As Object
    Dim rng As Range
    Dim pic As Picture

    ' 创建Outlook应用程序对象
    Set olApp = CreateObject("Outlook.Application")
    
    ' 创建新邮件
    Set olMail = olApp.CreateItem(0)
    
    ' 显示邮件窗口
    olMail.Display
    
    ' 获取邮件窗口的选择对象
    Set olInspector = olMail.GetInspector
    Set olSelection = olInspector.WordEditor.Application.Selection
    
    ' 遍历Excel中的每个图片
    For Each rng In ActiveSheet.Pictures
        ' 复制图片
        rng.CopyPicture xlScreen, xlPicture
        
        ' 在邮件窗口中粘贴图片
        olSelection.Paste
        
        ' 插入一个空行
        olSelection.TypeParagraph
        
        ' 移动到下一行
        olSelection.MoveDown
    Next rng
    
    ' 释放对象
    Set olSelection = Nothing
    Set olInspector = Nothing
    Set olMail = Nothing
    Set olApp = Nothing
End Sub