Anzeige

VBA
Programmierer
gesucht?
 
Anzeige
VBA Programmierer gesucht?
 

VBA Codeschnipselsammlung

Eine E-Mail an mehrere Empfänger aus einer Microsoft® Excel® Tabelle mit Abteilungsfilter in Outlook® vorbereiten/senden

Folgende Situation: Sie haben eine Abteilungstabelle und möchten gerne alle Mitarbeiter einer Abteilung per E-Mail anschreiben.

Zur Verdeutlichung einmal die Tabelle1 (Mitarbeiterliste mit E-Mails und Abteilung).

  A B C D E
 1  Emfängerabteilung: Abteilung A      
 2           
 3  Abteilung Name Vorname E-Mail  
 4  Abteilung A Wershoven Marc info@wershovenonline.de  
 5  Abteilung A Mustermann Max max.m@online-vba.de  
 6  Abteilung B Beispiel Berta berta.b@online-vba.de  
 7  Abteilung B Herzlich Hugo hugo.h@online-vba.com  


Wird nun in Zelle B1 mittels der Auswahlbox oder per Hand die Abteilung A eingetragen / ausgewählt, soll eine E-Mail an alle Mitarbeiter der Abteilung A vorbereitet werden. Für diese Vorbereitung finden Sie folgend ein Beispielmakro. Das Makro kann über eine Schaltfläche oder direkt mittels ALT+F8 gestartet werden. Hier überlasse ich Ihnen die freie Wahl.
Bitte verwenden Sie die Beispieldaten nicht für Ihren Testlauf, die angegebenen E-Mail Adressen sind frei erfunden!

Option Explicit
' ************************************************************************************************
' Autor/en: http://www.online-vba.de - Marc Wershoven
' Verwendung der Quelltexte auf eigene Gefahr!
' Es gelten die Nutzungsbedingungen von www.online-vba.de!
' Original-Quelltext: www.online-vba.de/vba_mailverteilerexcel.php
' ************************************************************************************************


Sub MW_AbteilungsVerteilerMailVersand()
   Dim oAppOutlook As Object
   Dim i As Long
   Dim sAbteilung As String
   Dim sTemp As String
    
     sAbteilung = Sheets("Tabelle1").Cells(1, 2).Value
     sTemp = ""
    
     With Sheets("Tabelle1")
         For i = 4 To .UsedRange.Rows.Count + .UsedRange.Row - 1
             If .Cells(i, 1).Value = sAbteilung Then
                 sTemp = sTemp & .Cells(i, 4).Value & ";"
             End If
         Next i
         'Das letzte Semikolon entfernen
         If Trim(sTemp) <> "" Then
             sTemp = Left(sTemp, Len(sTemp) - 1)
         End If
     End With
    
     'Wenn mindestens eine E-Mail Adresse gefunde wurde wird
     'eine E-Mail vorbereitet:
     If Trim(sTemp) <> "" Then
        
         Set oAppOutlook = CreateObject("Outlook.Application")
         With oAppOutlook.CreateItem(0)
              .To = sTemp 'Unser E-Mail Empfänger String aus sTemp
              .Subject = "Betreffzeile" 'E-Mail Betreffzeile
              .Body = "Mail-Inhalt..." 'E-Mail Inhalt
              .Display 'E-Mail anzeigen
              '.Send = Direkt senden
         End With
    
     Else
    
         MsgBox "Die gesuchte Abteilung hat keine " & _
             "hinterlegten Mitarbeiter oder E-Mail Adressen!"
    
     End If
    
     Set oAppOutlook = Nothing
End Sub


Autor: Marc Wershoven (2014)

Anzeige

VBA Programmierer gesucht?
http://www.WershovenOnline.de

Anzeige

Der Quick E-Mail Support von WershovenOnline®

Schnelle Hilfe bei Fragen rund um Microsoft® Office und VBA Makros

Der Quick E-Mail Support von WershovenOnline® Sie haben beispielsweise eine Frage zu einer Ihrer eigenen Makroprogrammierungen in VBA? Oder Sie suchen Unterstützung und Informationen über eine bestimmte Microsoft® Excel® Formel? Bei nahezu allen Fragen und Problemen rund um Microsoft® Office und VBA Makros steht Ihnen unser individueller Quick E-Mail Support zur Verfügung. Einfach, schnell und unkompliziert Ihre Frage in einer E-Mail formulieren, mit oder ohne Screenshots oder einer Beispieldatei absenden und kurze Zeit später haben Sie eine vollständige Lösung inkl. ausführlicher Erklärung vom Profi in Ihrem Postfach! Zusätzlich besteht die Option, dass wir uns mittels Fernwartung (selbstverständlich nach Ihrem Einvertändnis) direkt "live" mit Ihnen zusammen an Ihrem Bildschirm gemeinsam Fragen und Problemstellungen anschauen und lösen können!

Weitere Informationen zu diesem kostenpflichtigen Angebot finden Sie auf der Anbieterseite von WershovenOnline® auf www.wershovenonline.de.

Zum Anbieter des Quick-E-Mail-Support...

Zum Seitenanfang