einzel Dateien Separat x Mail schicken
05.11.2022 12:39:28
Giuppy
ich möchte jede Datei welche in einen Ordner vorhanden sind einzeln per mail versenden
z.B. 4 Datei dann 4 Separate Mail an dasselbe mailadresse schicken
Ich habe ein funktionierenden VBA, dass alle Dateien als Anhang in der Mail verschickt.
Welche VBA befehl soll ich ändern ?
Do While Len(strFile) > 0
.attachments.Add strPath & strFile
strFile = Dir
Loop
Eigentlich sollte auch eine Elseif eingefügt
z.B wenn der Kunde in der Z.Value 0 UND Z.Row der nummer 6 (z.B. Spalte J zeile 6 hat der Nummer 6) hat dann muss jede Datei separat verschickt werden ansosten sollte MailennachZeilen ausführen
ich glaube man sollte eine neue
Sub MailennachZeilenDatei mit geänderte do While schreiben.
https://www.herber.de/bbs/user/156025.xlsb
Kann mir jemand helfen
Vielen Dank
Giuppy
Sub a4_MAIL_Schleife()
Application.ScreenUpdating = False
Dim Z As Range 'Z wie Zelle
Sheets("Kontrolle").Select
If Range("E1") "OK" Then ' Kontrolle
MsgBox "Bitte RECHNUNGEN KONTROLLIEREN."
ElseIf Range("C1") = 0 Then ' Kontrolle
MsgBox "KEINE RECHNUNGEN."
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 = Worksheets("Stammdaten").Range("I" & 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 xxxx Ihnen für evtl. weitere Rückfragen zur Verfügung." & "
" _
& "Mit freundlichen Grüßen" & "
" _
& "Innendienst" & "
" _
& "XZY GmbH" & "
" _
& " ZZstrasse 6" & "
" _
& "8xxx XXXX" & "
" _
& "Tel. 089/xxxx" & "
" _
& "Fax 089/xxxxxx" & "
" _
& "Mail: " & "test@gmx.de" & "
"
With OutEmail
.GetInspector.Display
'olOldbody = .HTMLBody
'.GetInspector
.To = empfänger
'.CC = ""
OutEmail.Subject = Betreff
'.HTMLBody = Mailtext & olOldbody
.HTMLBody = Mailtext
'.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
Anzeige