保存のみ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 

私は1つを除いてまったく同じことがエクセルで、もう1つはPDFファイルであるという名前の2つのファイルを含む電子メールを取得します。私はただ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という文を1行使用してみてください。

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