Question

我想制作一个Outlook宏来调整大于100 KB的附加JPG文件的大小。这是针对收件箱中收到的邮件，而不是针对正在发送的邮件。

我有代码可以找到固定大小的附件JPG文件，但不确定如何调整它们的大小，然后将图像另存为附件。

Sub ResizeAttachedImage()
    Dim objMSG As Outlook.MailItem
    Dim oAtt As Outlook.Attachments
    Dim oFile
    Dim extn As String
    Dim sz As Long


    'Get the source email
    Select Case Application.ActiveWindow.Class
           Case olExplorer
                Set objMSG = ActiveExplorer.Selection.Item(1)
                objMSG.Display
           Case olInspector
                Set objMSG = ActiveInspector.CurrentItem
    End Select

    Set oAtt = objMSG.Attachments

    For Each oFile In oAtt      'loop through the list of file attachments

        'get the file extension
        extn= Right$(oFile.FileName, Len(oFile.FileName) - InStrRev(oFile.FileName, "."))

        If LCase(extn) = "jpg" Then   'process only jpg files

            sz = oFile.Size / 1024  'file size in kb
            If sz > 100 Then

                MsgBox (oFile.FileName + " is " + Str(sz) + " KB and needs to be resized") 'oFile.FileName

                'how to resize attached images to 50%
            End If
        End If
    Next

End Sub

Answer 1

OOM不允许您修改现有附件。唯一的方法是删除旧附件（Attachment.Delete）并添加新附件（MailItem.Attachments.Add）。如果要修改嵌入式图像附件，请确保使用PR_ATTACH_CONTENT_ID将http://schemas.microsoft.com/mapi/proptag/0x3712001F MAPI属性（DASL名称Attachment.PropertyAccessor.SetProperty）重置为其原始值。如果缺少PR_ATTACH_CONTENT_ID，则可能还必须设置PR_ATTACH_CONTENT_LOCATION（DASL名称http://schemas.microsoft.com/mapi/proptag/0x3713001F）。

如果可以选择使用Redemption（公开：我是它的作者），它将原始附件数据显示为RDOAttachment。AsText / AsArray / {{1} }，因此不必删除附件，然后再添加回去。

宏以调整Outlook邮件中附加图像的大小

1 个答案: