Alle Dateien eines Ordners senden

Alle Dateien mit einer Email senden

Dieses Beispiel hängt alle Dateien eines Verzeichnisses einer einzigen Email an und verschiebt die Dateien dann in einen anderen Ordner.

Tragen Sie bei m_Send das Verzeichnis ein, aus dem die Dateien versendet werden sollen. In m_Done steht das Verzeichnis, in das die Dateien abschließend verschoben werden sollen. Beide Angaben müssen mit einem Backslash enden. In m_To können Sie die Empfängeradresse eintragen. Über Extras/Referenzen müssen Sie einen Verweis auf die 'Microsoft Scripting Runtime' hinzufügen.

Wenn Sie beide Beispiele verwenden wollen, kopieren Sie die Funktion GetFiles und die Deklarationen der drei Variablen im Modulkopf trotzdem nur einmal. Starten können Sie die Makros z.B. über ALT+F8.

  So fügen Sie Makros in Outlook ein

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
  
  'Alle Dateien aus diesem Verzeichnis senden
  m_Send = "C:/Beispiel/"
  
  'Gesendete Dateien hierhin verschieben
  m_Done = "C:/Beispiel/Gesendet/"
  
  'Empfänger
  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
    'Nur die Dateien zurückgeben, die nicht versteckt sind
    If (File.Attributes Or Hidden) <> File.Attributes Then
      List.Add File
    End If
  Next
  Set GetFiles = List
End Function

Alle Dateien einzeln versenden

Dieses Beispiel erstellt eine Email pro Datei und schreibt den Dateinamen in die Betreffzeile der Email. Ansonsten gilt das gleiche wie oben.

Public Sub SendAllFiles()
  Dim Files As VBA.Collection
  Dim File As Scripting.File
  Dim Mail As Outlook.MailItem
  Dim Atts As Outlook.Attachments
  
  'Alle Dateien aus diesem Verzeichnis senden
  m_Send = "C:/Beispiel/"
  
  'Gesendete Dateien hierhin verschieben
  m_Done = "C:/Beispiel/Gesendet/"
  
  'Empfänger
  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
    'Nur die Dateien zurückgeben, die nicht versteckt sind
    If (File.Attributes Or Hidden) <> File.Attributes Then
      List.Add File
    End If
  Next
  Set GetFiles = List
End Function