電子メールから添付ファイル名を取得するvba

Question

私には、添付ファイル付きの電子メールと添付ファイルなしの電子メールがあるフォルダがあります。添付ファイルの名前を抽出するコードがありますが、電子メールに添付ファイルがない場合はコードが停止します。助けを歓迎します、ありがとうございます。

Private Sub CommandButton2_Click() 

Dim a As Attachments 
Dim myitem As Folder 
Dim myitem1 As MailItem 
Dim j As Long 
Dim i As Integer 

Set myitem = Session.GetDefaultFolder(olFolderDrafts) 

For i = 1 To myitem.Items.Count 
    If myitem.Items(i) = test1 Then 
    Set myitem1 = myitem.Items(i) 
    Set a = myitem1.Attachments 

    MsgBox a.Count 

    ' added this code 
    For j = 1 To myitem1.Attachments.Count 
     MsgBox myitem1.Attachments.Item(i).DisplayName ' or .Filename 
    Next j 

    End If 
Next i 
End Sub 

jimmypenaによって

マイコード：

Sub EXPORT() 

    Const FOLDER_PATH = "\\Mailbox\Inbox\emails from them" 
    Dim olkMsg As Object, _ 
     olkFld As Object, _ 
     excApp As Object, _ 
     excWkb As Object, _ 
     excWks As Object, _ 
     intRow As Integer, _ 
     intCnt As Integer, _ 
     strFileName As String, _ 
     arrCells As Variant 
     strFileName = "C:\EXPORT" 
     If strFileName <> "" Then 
     Set excApp = CreateObject("Excel.Application") 
     Set excWkb = excApp.Workbooks.Add() 
     Set excWks = excWkb.ActiveSheet 
     excApp.DisplayAlerts = False 
     With excWks 

      .Cells(1, 1) = "ATTACH NAMES" 
      .Cells(1, 2) = "SENDER" 
      .Cells(1, 3) = "NR SUBJECT" 
      .Cells(1, 4) = "CATEGORIES" 

     End With 
     intRow = 2 
     Set olkFld = OpenOutlookFolder(FOLDER_PATH) 
     For Each olkMsg In olkFld.Items 
      If olkMsg.Class = olMail Then 
       arrCells = Split(GetCells(olkMsg.HTMLBody), Chr(255)) 


        Dim Reg1 As RegExp 
        Dim M1 As MatchCollection 
        Dim M As match 
        Set Reg1 = New RegExp 
         With Reg1 
         .Pattern = "\s*[-]+\s*(\w*)\s*(\w*)" 
         .Global = True 
         End With 
          Set M1 = Reg1.Execute(olkMsg.Subject) 
          For Each M In M1 
       excWks.Cells(intRow, 3) = M 
          Next 

       Dim a As Attachments 
       Set a = olkMsg.Attachments 
       If Not a Is Nothing Then 


       excWks.Cells(intRow, 1) = olkMsg.Attachment.Filename 
       'excWks.Cells(intRow, 2) = olkMsg.SenderEmailAddress 
       End If 

       excWks.Cells(intRow, 2) = olkMsg.sender.GetExchangeUser.PrimarySmtpAddress 
       excWks.Cells(intRow, 4) = olkMsg.Categories 

       intRow = intRow + 1 
       intCnt = intCnt + 1 
      End If 
     Next 
     Set olkMsg = Nothing 
     excWkb.SaveAs strFileName, 52 
     excWkb.Close 
    End If 
    Set olkFld = Nothing 
    Set excWks = Nothing 
    Set excWkb = Nothing 
    Set excApp = Nothing 
    MsgBox "Ta dam! " 
End Sub 

Answer 1

が編集した質問についてのよう

Set a = myitem1.Attachments 
MsgBox a.Count 

For j = 1 To myitem1.Attachments.Count 
    MsgBox myitem1.Attachments.Item(j).DisplayName ' or .Filename 
Next j 

を編集し、次のスニペットを交換

  Dim a As Attachments 
      Set a = olkMsg.Attachments 
      If Not a Is Nothing Then 


      excWks.Cells(intRow, 1) = olkMsg.Attachment.Filename 
      'excWks.Cells(intRow, 2) = olkMsg.SenderEmailAddress 
      End If 

と：あなたはintRowインデックス用として適切に扱う必要があります

 Dim a As Attachment 
     For Each a In olkMsg.Attachments 
      excWks.Cells(intRow, 1) = a.FileName 
      'excWks.Cells(intRow, 2) = a.SenderEmailAddress 
     Next a 

。

あなただけの最初の添付ファイルに興味があるならば、あなたはこれで全体の最後のコードを置き換えることができ：

excWks.Cells(intRow, 1) = olkMsg.Attachments.Item(1).FileName 

あなたはすべての添付ファイルに興味があるなら、あなたはあなたのシートのレポートについて再考する必要がありますしながら、構造体