附加文件夹中的所有文件

Question

客户更喜欢在一封电子邮件中发送他们的每周发票附件。

我将系统设置为将所有发票发送给我，以便我可以将它们附加到一封电子邮件中。

我创建的宏将特定 Outlook 文件夹中电子邮件的所有附件保存到我计算机上的特定文件夹中。然后它起草了一封电子邮件供我发送给我的客户。

我需要宏将所有保存的文件附加到起草的电子邮件，然后从我计算机上的文件夹中删除这些文件。

Dim ol As Outlook.Application
Dim ns As Outlook.NameSpace
Dim fol As Outlook.MAPIFolder
Dim i As Object
Dim mi As Outlook.MailItem
Dim at As Outlook.Attachment

Set ol = New Outlook.Application
Set ns = ol.GetNamespace("MAPI")
Set fol = ns.GetDefaultFolder(olFolderInbox)
Set fol = fol.Folders("_CLIENT INVOICES")

For Each i In fol.Items

    If i.Class = olMail Then
    
        Set mi = i
        
        If mi.Attachments.Count > 0 Then
            
            For Each at In mi.Attachments
            
                If Right(at.FileName, 3) = "pdf" Then
            
                    at.SaveAsFile "C:\Users\MYNAME\OneDrive\CLIENT Invoices\" & at.FileName
                        
                End If
                
            Next at
            
        End If
        
    End If

Next i

'Drafting Email

Dim outlookapp As Object
Dim outlookmessage As Object

Set outlookapp = GetObject(Class:="Outlook.Application")
Set outlookmessage = outlookapp.CreateItem(0)

With outlookmessage
    .SentOnBehalfOfName = "OUR EMAIL"
    .To = "CLIENT EMAIL"
    .Subject = "Invoices"
    .Body = "Dear Valued Client," & vbNewLine & vbNewLine & "Attached please find the invoices for       
services provided." & vbNewLine & vbNewLine & "Thank you,"
    .Display
End With
On Error GoTo 0

Set outlookmessage = Nothing
Set outlookapp = Nothing

End Sub

Answer 1

首先，不需要在代码中创建和检索一个Outlook

Application

实例。发现了以下几行代码：

Set ol = New Outlook.Application

但稍后发送电子邮件时会重新检索实例：

Set outlookapp = GetObject(Class:="Outlook.Application")

其次，在文件夹中处理项目时，所有附件都保存到同一文件夹中：

For Each at In mi.Attachments
  If Right(at.FileName, 3) = "pdf" Then
    at.SaveAsFile "C:\Users\MYNAME\OneDrive\CLIENT Invoices\" & at.FileName
  End If
Next at

同名文件有可能保存到同一个文件夹，所以已经保存的文件可以被覆盖。我建议在文件名中添加任何 ID，不要依赖附件的

FileName

属性。例如，您可以考虑使用 RecievedTime 属性值。

第三，要附加文件夹中的所有文件，您可以使用以下代码：

Dim fso As Object
Dim fsFolder As Object
Dim fsFile As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set fsFolder = fso.GetFolder(strFolder)

For Each fsFile In fsFolder.Files
   If fsFile.Name Like "*.pdf" Then
      .Attachments.Add strFolder & "\" & fsFile.Name  
   End If
Next