Question

我正在使用宏来回复附件，但它总是将所有图片嵌入到邮件中并将它们作为附件...我试图插入一个代码段以排除所有png和gif格式，同时将附件下载到临时文件夹...

原始代码/工作，但下载以及嵌入图像

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：

   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

感谢您的建议： - ）

Answer 1

也许你让事情变得有点复杂。如果您只想排除png和gif，请使用If语句。改变这个：

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

VBA代码在保存附件时排除图像png和gif

1 个答案: