保存附件时排除图像png和gif的VBA代码 [英] VBA Code to exclude images png and gif when saving attachments

问题描述

我正在使用宏来回复附件，但它总是将嵌入在邮件中的所有图像都放入附件中...我正在尝试插入一个片段，以将附件下载到所有附件中时排除所有png和gif格式.临时文件夹...

I am using macro to reply with attachments, but it always takes all images embedded in the message and puts them as attachments... I am trying to insert a snippet to exclude all png and gif formats when downloading the attatchments to the temporary folder...

原始代码/有效，但下载的图像以及嵌入的图像

Original code / working, but downloading as well embeded images

Sub ReplyWithAttachments()
    Dim oReply As Outlook.MailItem
    Dim oItem As Object
    Set oItem = GetCurrentItem()
    If Not oItem Is Nothing Then
    Set oReply = oItem.Reply
    CopyAttachments oItem, oReply
    oReply.Display
    oItem.UnRead = False
    End If
    Set oReply = Nothing
    Set oItem = Nothing
    End Sub

Sub ReplyAllWithAttachments()
    Dim oReply As Outlook.MailItem
    Dim oItem As Object
    Set oItem = GetCurrentItem()
    If Not oItem Is Nothing Then
    Set oReply = oItem.ReplyAll
    CopyAttachments oItem, oReply
    oReply.Display
    oItem.UnRead = False
    End If
    Set oReply = Nothing
    Set oItem = Nothing
    End Sub

Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application
    Set objApp = Application
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
    Case "Explorer"
    Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
    Case "Inspector"
    Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
    End Select
    Set objApp = Nothing
    End Function

Sub CopyAttachments(objSourceItem, objTargetItem)
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fldTemp = fso.GetSpecialFolder(2) ' TemporaryFolder
    strPath = fldTemp.Path & "\"
    For Each objAtt In objSourceItem.Attachments
    strFile = strPath & objAtt.FileName
    objAtt.SaveAsFile strFile
    objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName
    fso.DeleteFile strFile
    Next
    Set fldTemp = Nothing
    Set fso = Nothing
    End Sub

我尝试在宏中实施的代码以排除图像png和gif:

Code I am trying to implement in my macro to exclude images png and gif:

   For i = lngCount To 1 Step -1

    ' Get the file name.
    strFile = objAttachments.Item(i).filename

' This code looks at the last 4 characters in a filename
      sFileType = LCase$(Right$(strFile, 4))

      Select Case sFileType
 ' Add additional file types below
       Case ".png", ".gif"
        If objAttachments.Item(i).Size < 5200 Then
     GoTo nexti
        End If
      End Select

    ' Combine with the path to the Temp folder.
    strFile = strFolderpath & strFile

    ' Save the attachment as a file.
    objAttachments.Item(i).SaveAsFile strFile

nexti:
    Next i

感谢您的建议:-)

推荐答案

也许您使事情有些复杂.如果只想排除png和gif，请使用If语句.更改此内容:

Maybe you're making things a bit complicated. If you just want to exclude png and gif use an If statement. Alter this:

For Each objAtt In objSourceItem.Attachments
strFile = strPath & objAtt.FileName
objAtt.SaveAsFile strFile
objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName
fso.DeleteFile strFile
Next

对此:

For Each objAtt In objSourceItem.Attachments
   If UCase(Right(objAtt.FileName, 3)) <> "PNG" And UCase(Right(objAtt.FileName, 3)) <> "GIF" Then
     strFile = strPath & objAtt.FileName
     objAtt.SaveAsFile strFile
     objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName
     fso.DeleteFile strFile
   End If
Next

这篇关于保存附件时排除图像png和gif的VBA代码的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！