用于调整Outlook邮件中附件图像大小的宏

Sub ResizeAttachmentImages()
    Dim objItem As Object
    Dim objMail As MailItem
    Dim objAttachment As Attachment
    Dim objTempMail As MailItem
    Dim objTempAttachment As Attachment
    Dim strTempFilePath As String
    
    ' 获取当前选中的邮件
    Set objItem = Application.ActiveExplorer.Selection.Item(1)
    
    ' 确保选中的是邮件
    If TypeOf objItem Is MailItem Then
        Set objMail = objItem
        
        ' 遍历所有附件
        For Each objAttachment In objMail.Attachments
            ' 检查附件是否为图像类型
            If objAttachment.Type = olByValue And objAttachment.IsImage Then
                ' 创建临时邮件并将附件保存到临时文件夹
                Set objTempMail = Application.CreateItem(olMailItem)
                Set objTempAttachment = objTempMail.Attachments.Add(objAttachment.Path)
                strTempFilePath = "C:\Temp\" & objAttachment.FileName
                objTempAttachment.SaveAsFile strTempFilePath
                
                ' 调整图像大小
                ' 这里可以使用任何图像处理库或工具来调整图像大小
                
                ' 将调整后的图像作为新附件添加到原始邮件
                objMail.Attachments.Add strTempFilePath, olByValue, , objAttachment.DisplayName
                
                ' 删除临时邮件和临时文件
                objTempMail.Delete
                Kill strTempFilePath
            End If
        Next objAttachment
    End If
End Sub