Microsoft Office Forum [ www.Office-Fragen.de ] >> READONLY <<

Microsoft Office 2003-2019 => Excel => Thema gestartet von: Davidoff99 am März 08, 2016, 17:58:00 Nachmittag

Titel: Office 2013: VBA Code zum Auslesen von E-Mailadressen und versenden
Beitrag von: Davidoff99 am März 08, 2016, 17:58:00 Nachmittag

Hallo liebe Forum Mitglieder,
ich versuche über ein VBA Modul, aus einer Excel Mappe mit unterschiedlichen Arbeitsblätter eine E-Mail an einen bestimmten Adressenbereich zu versenden. Hierbei verwende ich folgendes Skript:

---------------------
Sub Email_versenden()

Dim OlApp As Object
Dim olDummy As String
Dim Empfänger As Range
Dim Betreff As String
Dim Email As Range

Set OlApp = CreateObject("Outlook.Application")

    Betreff = Range("B1").Value 'Liest das Thema aus  Zelle B1 in der aktuellen Tabelle aus'
    Email = ActiveWorkbook.Worksheets("Master Data") 'Setz Variable Email auf Arbeitsblatt "Master Data"'
    Empfänger = Email.Range("I13:L40") 'Setz die Empfängerliste aus dem Arbeitsblatt "Maser Data" und dem Berreich "i30:l40" zusammen"
   
   
    If Empfänger = "" Then Exit Sub

With OlApp.CreateItem(0)
Rem Name des Sendekontos in Anführungszeichen, wird hier jedoch nicht benötigt aktueller Benutzer = Absender
            'Set .SendUsingAccount = .Session.Accounts.Item'
Rem Empfänger
          .To = Empfänger
Rem Optional Kopie an, hier kann eine weitere Range definiert werden
          .CC = ""
Rem Optional Blindkopie an, hier kann eine weitere Range definiert werden
          .BCC = ""
         
Rem Email anzeigen zum Einfügen der Signatur
          .GetInspector.Display
         
Rem Dummyzeile für Signatur. Zeile erforderlich
olDummy = .HTMLBody

Rem Betreff
          .Subject = "E-Mail zum Thema " & Betreff

Rem Textkörper (Body) im HTML-Format. (1 = Nur-Text, 2 = HTML, 3 = Rich-Text)
          .BodyFormat = 2
Rem "
" = Zeilenumbruch-Anweisung (nur bei HTML)
          .HTMLBody = "Sehr geehrtes Projekt Team" & _
          "

" & _
          "im Anhang erhalten Sie eine Liste zum Thema " & _
          Betreff & _
          "." & .HTMLBody
         
Rem  Mail sofort senden
  Rem         .Send
End With

End Sub
------------------------
Allerdings kann ich aus dem aktiven Arbeitsblatt nicht die Daten aus Arbeitsblatt „Master Data“ mit dem Bereich „i13:l40“ übernehmen. Hier sind die EmailAdressen hinterlegt. Diese werden durch eine entsprechende  "Wechseln"-Funktion erstellt und mit einer "WENN" Abfrage als Aktive markiert. 
Mir wird immer Laufzeitfehler 91 angezeigt und komme nicht weiter.
Wäre super wenn einer von euch mir hier weiterhelfen kann.
Grüße
Davidoff99

Titel: Antw:Office 2013: VBA Code zum Auslesen von E-Mailadressen und versenden
Beitrag von: Davidoff99 am März 09, 2016, 18:11:54 Nachmittag

Hab die Lösung gefunden:
----
Sub Send_Mail()
Dim OlApp As Object
Dim olDummy As String
Dim EmailTo As String
Dim Betreff As String
Dim Betreff2 As String
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String

Worksheets("Master Data").Activate 'Aktiviert das Sheet
EmailTo = Join(Application.Transpose(Worksheets("Master Data").Range("i17:i70").Value), ";") 'Liest die daten aus und setzt ein Semikon als trennung zwischen die Emailadressen
Worksheets("Bid Contacts List").Activate 'Aktiviert nächstes Sheet
Set OlApp = CreateObject("Outlook.Application")
    Betreff = Range("B1").Value 'Liest das Thema aus  Zelle B1 in der aktuellen Tabelle aus'
    Betreff2 = Range("b2").Value 'Liest das Thema aus  Zelle B2 in der aktuellen Tabelle aus'

 
  ' Define PDF filename

  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
 
  ' Export activesheet as PDF
  Worksheets("Opps Summary").Activate 'Aktiviert das Sheet
  Worksheets("Project-Timeline").Activate 'Aktiviert das Sheet
  Worksheets("ToDo-Liste").Activate 'Aktiviert das Sheet
  Worksheets("Report").Activate 'Aktiviert das Sheet
  ThisWorkbook.Sheets(Array("Opps Summary", "Project-Timeline", "ToDo-Liste", "Report")).Select
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
 
With OlApp.CreateItem(0)
Rem Name des Sendekontos in Anführungszeichen
            'Set .SendUsingAccount = .Session.Accounts.Item'
Rem Empfänger
          .To = EmailTo
         
Rem Optional Kopie an
          .CC = ""
Rem Optional Blindkopie an
          .BCC = ""
         
Rem Email anzeigen zum Einfügen der Signatur
          .GetInspector.Display
         
Rem Dummyzeile für Signatur. Zeile erforderlich
olDummy = .HTMLBody

Rem Betreff
          .Subject = Betreff & " | " & Betreff2 & " | " & " Project Update"

Rem Textkörper (Body) im HTML-Format. (1 = Nur-Text, 2 = HTML, 3 = Rich-Text)
          .BodyFormat = 2
         
Rem "
" = Zeilenumbruch-Anweisung (nur bei HTML)
        .HTMLBody = "<P STYLE='font-family:Trebuchet MS;font-size:11pt'>Dear Projekt Team" & _
          "

" & _
          "attached you will find the actually Project Overview of " & _
          Betreff & " Project: " & Betreff2 & _
          "." & strbody & .HTMLBody
         
          .Attachments.Add PdfFile
Rem  Mail sofort senden
  Rem         .Send
End With
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
End With
End Sub
----