VBA代碼在保存附件時排除圖像PNG和GIF

Question

我正在使用宏回覆附件，但它始終需要嵌入在消息中的所有圖像，並將它們作爲附件...我想插入一個片段以排除所有PNG和GIF格式下載attatchments到臨時文件夾...

原始代碼/工作的時候，但是下載以及嵌入式圖像

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