Send all Files of a Folder

Send all Files with one Email

This macro adds all files to one email and then moves the files to another folder.

The m_Send variable holds the directory of the files you want to send, m_Done holds the directory where you want to move the sent files. Both values must end with a backslash. m_To holds the email address of the recipient. Also, click on Tools/References, and check the 'Microsoft Scripting Runtime'.

If you want to use both macros, still copy the GetFiles function and the three variables on top only once. Launch the macros, for instance, by pressing ALT+F8.

  How to add macros to Outlook

Private m_Send as String
Private m_Done as String
Private m_To as String

Public Sub SendSingleFiles()
  Dim Files As VBA.Collection
  Dim File As Scripting.File
  Dim Mail As Outlook.MailItem
  Dim Atts As Outlook.Attachments
  
  'Send the files of this directory
  m_Send = "C:/Sample/"
  
  'Move send files here
  m_Done = "C:/Sample/Sent/"
  
  'Recipient
  m_To = ""
  
  Set Files = GetFiles
  If Files.Count Then
    Set Mail = Application.CreateItem(olMailItem)
    Set Atts = Mail.Attachments
    For Each File In Files
      Atts.Add File.Path
      File.Move m_Done & File.Name
    Next
    Mail.To = m_To
    Mail.Subject = "xxx"
    Mail.Display
  End If
End Sub

Private Function GetFiles() As VBA.Collection
  Dim Folder As Scripting.Folder
  Dim Fso As Scripting.FileSystemObject
  Dim Files As Scripting.Files
  Dim File As Scripting.File
  Dim List As VBA.Collection
  
  Set List = New VBA.Collection
  Set Fso = New Scripting.FileSystemObject
  Set Folder = Fso.GetFolder(m_Send)
  Set Files = Folder.Files
  For Each File In Files
    'return only those files that are not hidden
    If (File.Attributes Or Hidden) <> File.Attributes Then
      List.Add File
    End If
  Next
  Set GetFiles = List
End Function

Send all Files separatedly

This sample creates one email per file and adds the file name to the subject of the email. Everything else is equal to the sample above.

Public Sub SendAllFiles()
  Dim Files As VBA.Collection
  Dim File As Scripting.File
  Dim Mail As Outlook.MailItem
  Dim Atts As Outlook.Attachments
  
  'Send the files of this directory
  m_Send = "C:/Sample/"
  
  'Move send files here
  m_Done = "C:/Sample/Sent/"
  
  'Recipient
  m_To = ""
  
  Set Files = GetFiles
  If Files.Count Then
    For Each File In Files
      Set Mail = Application.CreateItem(olMailItem)
      Mail.Attachments.Add File.Path
      File.Move m_Done & File.Name
      Mail.To = m_To
      Mail.Subject = "Datei: " & File.Name
      Mail.Display
    Next
  End If
End Sub

Private Function GetFiles() As VBA.Collection
  Dim Folder As Scripting.Folder
  Dim Fso As Scripting.FileSystemObject
  Dim Files As Scripting.Files
  Dim File As Scripting.File
  Dim List As VBA.Collection
  
  Set List = New VBA.Collection
  Set Fso = New Scripting.FileSystemObject
  Set Folder = Fso.GetFolder(m_Send)
  Set Files = Folder.Files
  For Each File In Files
    'return only those files that are not hidden
    If (File.Attributes Or Hidden) <> File.Attributes Then
      List.Add File
    End If
  Next
  Set GetFiles = List
End Function