Question

我有以下代码将所有附件保存到给定文件夹，这是我大多数时间都想要的，但是我需要在特定实例中仅保存一种类型的附件，例如只说PDF或仅XLS。

我需要在代码中添加什么才能执行此操作。

我的代码：

Public Sub SavePayRoll()
' Save data from Payroll Service
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String

    ' Get the path to folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    On Error Resume Next

    ' Instantiate an Outlook Application object.
    Set objOL = CreateObject("Outlook.Application")

    ' Get the collection of selected objects.
    Set objSelection = objOL.ActiveExplorer.Selection

' The attachment folder needs to exist
' You can change this to another folder name of your choice

    ' Set the Attachment folder.
  strFolderpath = "C:\DrBox\"



    ' Check each selected item for attachments.
    For Each objMsg In objSelection

    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count

    If lngCount > 0 Then

    ' Use a count down loop for removing items
    ' from a collection. Otherwise, the loop counter gets
    ' confused and only every other item is removed.

    For i = lngCount To 1 Step -1

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

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

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

    Next i
    End If

    Next

ExitSub:

Dim shel As String
shel = strFolderpath

Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing

Dim retVal As Long
    retVal = Shell("explorer.exe " & shel, vbNormalFocus)

End Sub

提前致谢

Answer 1

您可以尝试检查strFile是否具有您想要的扩展程序，例如

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

' Only save pdf files
If strFile.EndsWith("pdf") Then
    ' Combine with the path to the Temp folder.
    strFile = strFolderpath & strFile

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

Answer 2

谢谢@Dat你的建议给出了错误，但是你让我走上正轨，我的代码现在读了

dim sFileType as string

 ' Get the file name.
strFile = objAttachments.Item(i).FileName
sFileType = LCase$(Right$(strFile, 4))
MsgBox (sFileType)
' Only save pdf files
     If sFileType = ".pdf" Then
' Combine with the path to the Temp folder.
strFile = strFolderpath & strFile

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

    Works fine!

仅保存一种附件

2 个答案: