VBA Mail Send

Hallo
ich möchte verschieden mail mit Anhang mit ein VBA verschicken.
Wenn ich der einzeln code durchführe funktioniert aber wenn ich zusammen verschicken will bleibt (an bei 3_Mail_T) .Send stelle hängen
Kann mir jemand helfen
Anbei den VBA


Sub MAIL_ALL_TEST()
'Application.ScreenUpdating = False
Sheets("Kontrolle").Select
If Range("E2") = "RECH. KONTROLLIEREN" Then   ' Kontrolle
MsgBox "Bitte RECHNUNGEN KONTROLLIEREN."
Else
If Range("B2") > 0 Then
Call 2_Mail_T
If Range("B3") > 0 Then
Call 3_mail_T
If Range("B4") > 0 Then
Call 4_Mail_T
If Range("B5") > 0 Then
Call 5_Mail_T
If Range("B6") > 0 Then
Call 6_Mail_T
If Range("B7") > 0 Then
Call 7_Mail_T
If Range("B8") > 0 Then
Call 8_Mail_T
If Range("B9") > 0 Then
Call 9_Mail_T
If Range("B10") > 0 Then
Call 10_Mail_T
If Range("B11") > 0 Then
Call 11_Mail_T
If Range("B12") > 0 Then
Call 12_Mail_T
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Range("H11").Select
End Sub


Sub 2_Mail_T()
Sheets("Kontrolle").Select
Dim Nachricht As Object, OutlookApplication As Object
Set OutlookApplication = CreateObject("Outlook.Application")
Dim Anhang As String
Dim Betreff As String
Dim Mailtext As String
Dim strSignature As String
Dim StrPath As String, StrFile As String
Sheets("Kontrolle").Select
Range("G2").Select
NamDat = Range("H6")
Betreff = "2_" & NamDat
StrPath = "C:\#KDFatture\MAIL_NEW\PDF\2_PDF\"
Set Nachricht = OutlookApplication.CreateItem(0)
Mailtext = "" & _
"Sehr geehrte Damen und Herren ," & "
" & "anbei sende ich Ihnen die Rechnungen für den Zeitraum " & NamDat & "
" & _
"Gerne stehen wir aus xxx Ihnen für evtl. weitere Rückfragen zur Verfügung." & "
" & ""
With Nachricht
.GetInspector
strSignature = "
" & .HTMLBody
.To = "xxx@outlook.com"
.Subject = Betreff
StrFile = Dir(StrPath & "*.*")
Do While Len(StrFile) > 0
.attachments.Add StrPath & StrFile
StrFile = Dir
Loop
.HTMLBody = Mailtext & strSignature
'.display
.Send
End With
Set OutlookApplication = Nothing
Set Nachricht = Nothing
'End If
End Sub


Sub 3_mail_T()
Sheets("Kontrolle").Select
Range("G3").Select
Dim Nachricht As Object, OutlookApplication As Object
Set OutlookApplication = CreateObject("Outlook.Application")
Dim Anhang As String
Dim Betreff As String
Dim Mailtext As String
Dim strSignature As String
Sheets("Kontrolle").Select
NamDat = Range("H6")
Betreff = "3_" & NamDat
StrPath = "C:\#KDFatture\MAIL_NEW\PDF\3_PDF\"
Set Nachricht = OutlookApplication.CreateItem(0)
Mailtext = "" & _
"Sehr geehrte Damen und Herren ," & "
" & "anbei sende ich Ihnen die Rechnungen für den Zeitraum " & NamDat & "
" & _
"Gerne stehen wir aus xxx Ihnen für evtl. weitere Rückfragen zur Verfügung." & "
" & ""
With Nachricht
.GetInspector
strSignature = "
" & .HTMLBody
.To = "xxx@outlook.com"
.Subject = Betreff
StrFile = Dir(StrPath & "*.*")
Do While Len(StrFile) > 0
.attachments.Add StrPath & StrFile
StrFile = Dir
Loop
.HTMLBody = Mailtext & strSignature
'.display
.Send
End With
Set OutlookApplication = Nothing
Set Nachricht = Nothing
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub MAIL_ALL_TEST() 'Application.ScreenUpdating = False Sheets("Kontrolle").Select If Range("E2") = "RECH. KONTROLLIEREN" Then ' Kontrolle MsgBox "Bitte RECHNUNGEN KONTROLLIEREN." Else If Range("B2") > 0 Then Call B2_Mail_T Else End If If Range("B3") > 0 Then Call B3_mail_T Else End If If Range("B4") > 0 Then Call B4_Mail_T Else End If If Range("B5") > 0 Then Call B5_Mail_T Else End If If Range("B6") > 0 Then Call B6_Mail_T Else End If If Range("B7") > 0 Then Call B7_Mail_T Else End If If Range("B8") > 0 Then Call B8_Mail_T Else End If If Range("B9") > 0 Then Call B9_Mail_T Else End If If Range("B10") > 0 Then Call B10_Mail_T Else End If If Range("B11") > 0 Then Call B11_Mail_T Else End If If Range("B12") > 0 Then Call B12_Mail_T End If End If Range("H11").Select End Sub

Sub MAIL_ALL_TEST() 'Application.ScreenUpdating = False Dim Z As Range 'Z wie Zelle Sheets("Kontrolle").Select If Range("E2") "" Then ' Kontrolle MsgBox "Bitte RECHNUNGEN KONTROLLIEREN." Else For Each Z In Range(Range("B2"), Cells(Rows.Count, 2).End(xlUp)) If Z.Value 0 Then MailenNachZeilen Z.Row, Range("H6").Value Next End If Range("H11").Select End Sub Sub MailenNachZeilen(ZeileNr As Long, Zeitraum as String) Dim OutlookApplication As New Outlook.Application Dim Nachricht As New MailItem Dim Mailtext As String Dim strPath As String Dim strFile As String strPath = "C:\#KDFatture\MAIL_NEW\PDF\B" & ZeileNr & "_PDF\" Mailtext = "" _ & "Sehr geehrte Damen und Herren ," & " " _ & "anbei sende ich Ihnen die Rechnungen für den Zeitraum " & Zeitraum & " " _ & "Gerne stehen wir aus Oberhaching Ihnen für evtl. weitere Rückfragen zur Verfügung." & " " & "" With Nachricht .GetInspector .To = "giuppy@gmx.de" .Subject = "B" & ZeileNr & "_" & Zeitraum .HTMLBody = Mailtext & " " & .HTMLBody '.attachments.Add Anhang strFile = Dir(strPath & "*.*") Do While Len(strFile) > 0 .attachments.Add strPath & strFile strFile = Dir Loop '.display .Send End With Set OutlookApplication = Nothing Set Nachricht = Nothing End Sub

Hallo YAL,
grazie :-)
ich werde ausprobieren.
auch der Strpath sollte geändert werden
'strPath = "C:\#KDFatture\MAIL_NEW\PDF\B" & ZeileNr & "_PDF\"
'strPath = "C:\#KDFatture\MAIL_NEW\PDF\"& Range("A" & ZeileNr).Value &"_PDF\"
Wie kann ich mehrere mailadresse in der schleife bringen?
z.B.
Kunden B2 die mailadresse xxxx@xxx dann .to ="xxx@xxx"
Kunden B3 die mailadresse yyy@yyy dann .to ="yyy@yyy"
Kunden B4 die mailadresse zzz@zzz dann .to ="zzz@zzz"
usw
Die mailadresse konnte ich in der Spalte O schreiben
Falls der Kunden in A2 Rechnungen hat ( große 0 in B2) dann mail senden (Adresse ist in O2 geschrieben)
Jeder Kunden hat ein Separat Ordner z.B. Name der Kunden (A2)_PDF in dem werden mit ein anderem VBA die Rechnungen kopiert ( habe schon getestet und funktioniert)
Schöne Grüße
Giuppy

Sub MAIL_Schleife_TEST() 'Application.ScreenUpdating = False Dim Z As Range 'Z wie Zelle Sheets("Kontrolle").Select If Range("E2") "OK" Then ' Kontrolle MsgBox "Bitte RECHNUNGEN KONTROLLIEREN." Else For Each Z In Range(Range("B2"), Cells(Rows.Count, 2).End(xlUp)) If Z.Value 0 Then MailenNachZeilen Z.Row, Range("H6").Value Next End If Range("H11").Select End Sub

Sub MailenNachZeilen(ZeileNr As Long, Zeitraum As String) Dim OutlookApplication As New Outlook.Application 'Dim Nachricht As New MailItem Dim Nachricht As MailItem Dim Mailtext As String Dim strPath As String Dim strFile As String Dim empfänger As String Dim Betreff As String Zeitraum = Range("H6") empfänger = Range("O" & ZeileNr).Value Betreff = Range("A" & ZeileNr).Value & "_" & Zeitraum strPath = "C:\#KDFatture\MAIL_NEW\PDF\" & Range("A" & ZeileNr).Value & "_PDF\" Mailtext = "" _ & "Sehr geehrte Damen und Herren ," & " " _ & "anbei sende ich Ihnen die Rechnungen für den Zeitraum " & Zeitraum & " " _ & "Gerne stehen wir aus Oberhaching Ihnen für evtl. weitere Rückfragen zur Verfügung." & " " & "" With Nachricht '.GetInspector .To = empfänger .CC = "giuppy@gmx.de" Subject = Betreff .HTMLBody = Mailtext & " " & .HTMLBody '.attachments.Add Anhang strFile = Dir(strPath & "*.*") Do While Len(strFile) > 0 .attachments.Add strPath & strFile strFile = Dir Loop .display '.Send End With Set OutlookApplication = Nothing Set Nachricht = Nothing End Sub

Sub MAIL_Schleife_TEST1() Application.ScreenUpdating = False Dim Z As Range 'Z wie Zelle Sheets("Kontrolle").Select If Range("E2") "OK" Then ' Kontrolle MsgBox "Bitte RECHNUNGEN KONTROLLIEREN." Else For Each Z In Range(Range("B2"), Cells(Rows.Count, 2).End(xlUp)) If Z.Value 0 Then MailenNachZeilen Z.Row, Range("H6").Value Next End If Range("H11").Select End Sub

Sub MailenNachZeilen(ZeileNr As Long, Zeitraum As String) Application.ScreenUpdating = False Dim OutApp As Outlook.Application Dim OutEmail As Outlook.MailItem 'Eine neue Instanz von Outlook erzeugen Set OutApp = New Outlook.Application Set OutEmail = OutApp.CreateItem(olMailItem) Dim Mailtext As String Dim strPath As String Dim strFile As String Dim empfänger As String Dim Betreff As String 'Zeitraum = Range("H6") empfänger = Range("O" & ZeileNr).Value Betreff = Range("A" & ZeileNr).Value & "_" & Zeitraum strPath = "C:\#KDFatture\MAIL_NEW\PDF\" & Range("A" & ZeileNr).Value & "_PDF\" Mailtext = "" _ & "Sehr geehrte Damen und Herren ," & " " _ & "anbei sende ich Ihnen die Rechnungen für den Zeitraum " & Zeitraum & " " _ & "Gerne stehen wir aus Oberhaching Ihnen für evtl. weitere Rückfragen zur Verfügung." & " " & "" With OutEmail .GetInspector.Display olOldbody = .HTMLBody '.GetInspector .To = empfänger '.CC = "" OutEmail.Subject = Betreff .HTMLBody = Mailtext & olOldbody strFile = Dir(strPath & "*.*") Do While Len(strFile) > 0 .attachments.Add strPath & strFile strFile = Dir Loop '.display .Send End With Set OutlookApplication = Nothing Set Nachricht = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread