Сохранить вложения только PDF VBA Перспективы

Question

Это то, что я до сих пор:

Public Sub saveAttachtoDisk(itm As Outlook.MailItem) 
Dim objAtt As Outlook.Attachment 
Dim saveFolder As String 
saveFolder = "P:\ME\TEST\" 
Dim dateFormat 
dateFormat = Format(Now, "yyyy.mm.dd") 
For Each objAtt In itm.Attachments 
    If InStr(1, objAtt.FileName, "HALJD", vbTextCompare) > 0 Then 
    objAtt.SaveAsFile saveFolder & dateFormat & " ASDF ADFA.pdf" 
    ElseIf InStr(1, objAtt.FileName, "Generic", vbTextCompare) > 0 Then 
    objAtt.SaveAsFile saveFolder & dateFormat & " asdf asdf asdf.pdf" 
    ElseIf InStr(1, objAtt.FileName, "asdfa asdfsa", vbTextCompare) > 0 Then 
    objAtt.SaveAsFile saveFolder & dateFormat & " asdfds adsfa asdf a.pdf" 
    ElseIf InStr(1, objAtt.FileName, "asdfs_asdfs", vbTextCompare) Then 
    objAtt.SaveAsFile saveFolder & dateFormat & " asfd asfda sadfsad.pdf" 
    Else 
    End If 
Set objAtt = Nothing 
Next 
End Sub 

Я получаю письма с двумя файлами назвали одно и то же, за исключением одного является первенствует и один PDF. Мне просто нужен PDF, но я не уверен, как это кодировать. Просто нужно бросить строку после последнего утверждения elseif? Дайте мне знать, что вы придумали.

Спасибо за помощь!

Answer 1

Я не полностью протестировал это, так как это немного комбинация вашего кода и моего.

Основные биты, чтобы смотреть на это
Set objFSO = CreateObject("Scripting.FileSystemObject") и
sExt = objFSO.GetExtensionName(objAtt.FileName)

Sub saveAttachtoDisk(ByVal item As MailItem) 

    Dim objAtt As Attachment 
    Dim i As Integer 
    Dim dateFormat As String 
    Dim objFSO As Object 
    Dim sExt As String 

    dateFormat = Format(Date, "yyyy.mm.dd") 

    'Only proceed if the email contains attachements. 
    If item.Attachments.Count > 0 Then 
     Set objFSO = CreateObject("Scripting.FileSystemObject") 

     'Cycle through each attachment on the email. 
     For i = 1 To item.Attachments.Count 
      Set objAtt = item.Attachments(i) 

      'Get the extension of the attached file name. 
      sExt = objFSO.GetExtensionName(objAtt.FileName) 

      If sExt = "pdf" Then 
       If InStr(1, objAtt.FileName, "HALJD", vbTextCompare) > 0 Then 
        objAtt.SaveAsFile saveFolder & dateFormat & " ASDF ADFA.pdf" 
       ElseIf InStr(1, objAtt.FileName, "Generic", vbTextCompare) > 0 Then 
        objAtt.SaveAsFile saveFolder & dateFormat & " asdf asdf asdf.pdf" 
       ElseIf InStr(1, objAtt.FileName, "asdfa asdfsa", vbTextCompare) > 0 Then 
        objAtt.SaveAsFile saveFolder & dateFormat & " asdfds adsfa asdf a.pdf" 
       ElseIf InStr(1, objAtt.FileName, "asdfs_asdfs", vbTextCompare) Then 
        objAtt.SaveAsFile saveFolder & dateFormat & " asfd asfda sadfsad.pdf" 
       End If 
      End If 

      'Any remaining events are completed before the code continues. 
      DoEvents 
      Set objAtt = Nothing 
     Next i 
     Set objFSO = Nothing 
    End If 
End Sub 

Answer 2

Рассмотрим непосредственно проверять расширение в имени файла с RIGHT(..., 3). Для обеспечения удобочитаемости и ремонтопригодности рассмотрите переформулировку макроса с помощью LIKE и определите строковую переменную условно, затем постройте путь к файлу в SaveAs. Наконец, попробуйте просто использовать одну строку If:

Public Sub saveAttachtoDisk(itm As Outlook.MailItem) 

    Dim objAtt As Outlook.Attachment 
    Dim saveFolder As String: saveFolder = "P:\ME\TEST\" 
    Dim dateFormat: dateFormat = Format(Now, "yyyy.mm.dd") 
    Dim strFile As String 

    For Each objAtt In itm.Attachments 

    If Right(objAtt.FileName, 3) = "pdf" Then 
     If objAtt.FileName Like "*HALJD*" Then strFile = " ASDF ADFA.pdf" 
     If objAtt.FileName Like "*Generic*" Then strFile = " asdf asdf asdf.pdf" 
     If objAtt.FileName Like "*asdfa asdfsa*" Then strFile = " asdfds adsfa asdf a.pdf" 
     If objAtt.FileName Like "*asdfs_asdfs*" Then strFile = " asfd asfda sadfsad.pdf" 

     objAtt.SaveAsFile saveFolder & dateFormat & strFile 
    End If   

    Next objAtt 

    Set objAtt = Nothing 
End Sub