Ищете только вложения в формате .pdf - PullRequest
Новая
       56

Ищете только вложения в формате .pdf

0 голосов
/ 13 декабря 2018

Я просто хочу сохранить PDF-файлы из выбранных вложений электронной почты в папку на моем компьютере.Прямо сейчас с кодом ниже он сохраняет все вложения, такие как элементы JPG и htm.У меня есть выбор для файлов PDF в неправильном месте?После игры, где бы я ни размещал код для выбора PDF-файлов, кажется, что он фактически не выбирает PDF-файлы 

 Sub SavePDFAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim l As Long
Dim lngCount As Long
Dim tlngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String
Dim finalpath As String

    On Error Resume Next

    ' Instantiate an Outlook Application object.
    Set objOL = Application

    ' Get the collection of selected objects.
    Set objSelection = objOL.ActiveExplorer.Selection
    ' Set the Attachment folder.
    strFolderpath = "T:"

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

    Set objAttachments = objMsg.Attachments

    ' Pull PDFs only
    For Each objAttachment In objMsg.Attachments
    If Right(objAttachment.FileName, 3) = "pdf" Then
    objAttachment.SaveAsFile strFolderpath & strFile
    End If

    Next objAttachment

    lngCount = objAttachments.count

    If lngCount > 0 Then

    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:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

1 Ответ

0 голосов
/ 13 декабря 2018

Пожалуйста, обратитесь к следующему коду: 

 Public Sub SaveAttachments()
    Dim objOL As Outlook.Application
    Dim objMsg As Outlook.MailItem 'Object          
    Dim strFile As String
    Dim strFolderpath As String
    Dim strDeletedFiles As String

    ' Get the path to your My Documents folder
    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 = "\\UKSH000-FILE06\Purchasing\New_Supplier_Set_Ups_&_Audits\ATTACHMENTS\TEST\"

    ' Check each selected item for attachments.
    For Each objMsg In objSelection
        For each objAttachment in objMsg.Attachments
            if Right(objAttachment.FileName, 3) = "pdf" then                

                    ' Append the file name to the folder.
                    strFile = strFolderpath & objAttachment.FileName

                    ' Save it
                    objAttachments.Item(i).SaveAsFile strFile                   
            end if
        Next objAttachment
    Next objMsg

ExitSub:
    Set objAttachments = Nothing
    Set objMsg = Nothing
    Set objSelection = Nothing
    Set objOL = Nothing
End Sub

Сохранить PDF-код: 

if Right(objAttachment.FileName, 3) = "pdf" then

Для получения дополнительной информации, пожалуйста, перейдите по ссылке: VBA сохранить вложения электронной почты с PDFрасширение к папке

...