Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1816to1820
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Mail versenden mit Adresse aus TB

Mail versenden mit Adresse aus TB
02.03.2021 11:49:05
Andreas
Hallo,
ich möchte aus einer Exceldatei mit mehreren Tabellenblättern die einzelnen Tabellenblätter als Mail (über Outlook) versenden. In jedem Tabellenblatt steht in F1 die Mailadresse. Ersatzweise könnte ich auch die Tabellenblätter mit den Vornamen.Nachname versehen, da nach dem @ eine gleichlautende Adresse kommt.
Ich haben schon Anleitungen gefunden, eine Mail für ein TB zu senden. Aber für mehrere ....?
Da bin ich überfordert.
Vielleicht kann mir hier jemand helfen.
Vielen Dank schon mal.
Gruß Andreas

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
dann zeig doch..
02.03.2021 11:52:26
UweD
mal dein bisheriges Makro
LG UweD

AW: dann zeig doch..
02.03.2021 13:08:07
Andreas
Hier der Code, der für ein Tabellenblatt funktioniert.
Sub pdfMail()
Dim mePDFD As String
Dim MyOutApp As Object, MyMessage As Object
mePDFD = ThisWorkbook.Path & "\plan.pdf" 'pdf aus den verschiedenen Tabellenblättern?
Sheets("Bec").Copy 'Name des einen Tabellenblatts
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=mePDFD, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
ActiveWorkbook.Close False
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = "info@testadresse.de"  'Adressen aus Zelle A1?
.Subject = "Hier der aktuelle Plan" 'Betreffzeile
.body = "Bei Bedarf bitte Rückruf"
.Attachments.Add mePDFD
.Display
'.Send
End With
'Kill mePDFD
Set MyMessage = Nothing
Set MyOutApp = Nothing
End Sub
Gruß Andreas

Anzeige
so?
02.03.2021 15:02:29
UweD
Hallo

Option Explicit
Sub pdfMail()
Dim mePDFD As String, strTo As String, TB As Worksheet
Dim MyOutApp As Object, MyMessage As Object
mePDFD = ThisWorkbook.Path & "\plan.pdf" 'pdf aus den verschiedenen Tabellenblättern?
For Each TB In ThisWorkbook.Sheets
If TB.Name  "Dieses Blatt nicht" Then 'falls ein Blatt nicht betroffen ist
strTo = TB.Range("A1")
TB.Copy
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=mePDFD, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
ActiveWorkbook.Close False
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = strTo  'Adressen aus Zelle A1?
.Subject = "Hier der aktuelle Plan" 'Betreffzeile
.body = "Bei Bedarf bitte Rückruf"
.Attachments.Add mePDFD
.Display
'.Send
End With
'Kill mePDFD
Set MyMessage = Nothing
Set MyOutApp = Nothing
End If
Next
End Sub

LG UweD

Anzeige
AW: so?
02.03.2021 15:43:30
Andreas
Hallo UweD,
bin leider z.Z. nicht am PC und kann testen, gebe dir morgen früh eine Rückmeldung.
Bis dahin Danke schon mal.
Gruß Andreas

AW: so?
03.03.2021 07:14:52
Andreas
Hallo UweD,
also, ich habe das Makro jetzt getestet - es funktioniert (fast) perfekt.
Eine Frage/Wunsch noch zu folgender Problematik:
ich habe zum Testen aus meiner eigentlichen Exceldatei alle bis auf vier Tabellenblätter gelöscht.
Läuft durch, nur wird dann jeweils bei Outlook ein neues Fenster geöffnet (s. Bild). Bei vier geht das ja noch. Real sind das aber 85 Tabellenblätter. Das wäre glaube ich ein bischen viel.
Könnte man nicht auch nur die Tabellenblätter versenden, die man markiert hat? So könnte man jeweils 10 auswählen ... Hast du vielleicht eine Idee?
Vielen Dank!
Gruß Andreas
Userbild

Anzeige
AW: so?
03.03.2021 09:16:41
UweD
Hallo
ja, das geht so..

Sub pdfMail()
Dim mePDFD As String, strTo As String, TB As Worksheet
Dim MyOutApp As Object, MyMessage As Object
mePDFD = ThisWorkbook.Path & "\plan.pdf" 'pdf aus den verschiedenen Tabellenblättern?
For Each TB In ActiveWindow.SelectedSheets
strTo = TB.Range("A1")
TB.Copy
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=mePDFD, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
ActiveWorkbook.Close False
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = strTo  'Adressen aus Zelle A1?
.Subject = "Hier der aktuelle Plan" 'Betreffzeile
.body = "Bei Bedarf bitte Rückruf"
.Attachments.Add mePDFD
.Display
'.Send
End With
'Kill mePDFD
Set MyMessage = Nothing
Set MyOutApp = Nothing
Next
End Sub

Aber:
Es scheint doch darauf abzuzielen, automatisch die mails zu erzeugen und zu versenden
Wenn du das Makro doch ausreichend geprüft hast und es funktioniert, dann würde ich
das Display rausnehemen und sofort senden

'.Display
.Send

LG UweD

Anzeige
AW: so?
03.03.2021 09:30:21
Andreas
Hallo UweD,
super, so läuft es genau wie ich es wollte.
Vielen Dank!
Deinen Hinweis mit dem '.Display habe ich auch umgesetzt.
LG Andreas

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige