z.b. so
31.08.2021 23:58:36
ralf_b
ungetestet.
Option Explicit
Public Sub Mail_per_Auftragsbestätigung()
Dim sVerz As String
sVerz = Kunden_Ordneranlegen(Range("D11").Value, Range("E24").Value, Range("E25").Value)
Call createpdf("$B$2:$H$59", sVerz & "Auftragsbestätigung")
Call KundenMail(ActiveSheet.Range("D16").Value, sVerz & "Auftragsbestätigung")
End Sub
Public Sub Mail_per_Lieferschein()
Dim sVerz As String
sVerz = Kunden_Ordneranlegen(Range("D11").Value, Range("E24").Value, Range("E25").Value)
Call createpdf("$B$70:$H$137", sVerz & "Lieferschein")
Call KundenMail(ActiveSheet.Range("D16").Value, sVerz & "Lieferschein")
End Sub
Public Sub Mail_per_Bestellung()
Dim sVerz As String
sVerz = Kunden_Ordneranlegen(Range("D11").Value, Range("E24").Value, Range("E25").Value)
Call createpdf("B139:H206", sVerz & "Bestellung")
Call KundenMail(ActiveSheet.Range("D16").Value, sVerz & "Bestellung")
End Sub
Public Sub Mail_per_ALLE()
Dim sAnhang As String
Dim sVerz As String
sVerz = Kunden_Ordneranlegen(Range("D11").Value, Range("E24").Value, Range("E25").Value)
Call createpdf("$B$2:$H$59", sVerz & "Auftragsbestätigung")
Call createpdf("$B$139:$H$206", sVerz & "Bestellung")
Call createpdf("$B$70:$H$137", sVerz & "Lieferschein")
sAnhang = sVerz & "Auftragsbestätigung"
sAnhang = sAnhang & ";" & sVerz & "Bestellung"
sAnhang = sAnhang & ";" & sVerz & "Lieferschein"
Call KundenMail(ActiveSheet.Range("D16").Value, sAnhang)
End Sub
Public Function Kunden_Ordneranlegen(sTeil1 As String, sTeil2 As String, sTeil3 As String) As String
Dim Verz, VerzPDF, VerzOrd, VerzNam As String
Dim strPath$, Name, NetzN, NetzN2, lauf, DateiN, PathVerz
lauf = "C:"
Verz = "\Aufträge\"
VerzOrd = Verz
VerzPDF = lauf & "\Aufträge"
PathVerz = strPath & VerzOrd
' Name = Sheets("Aufträge").Range("S1")
VerzOrd = PathVerz & sTeil1
' DateiN = ThisWorkbook.Name
VerzNam = sTeil1 & " " & sTeil2 & " " & sTeil3 & ".pdf"
'VerzNam = ActiveSheet.Range("D11") & " " & ActiveSheet.Range("E24") & " " & ActiveSheet.Range("E25") & ".pdf"
If Dir(VerzOrd, vbDirectory) = "" Then
MkDir VerzOrd
MsgBox "Verzeichnis: " & Chr(13) & Chr(13) & VerzOrd & Chr(13) & Chr(13) & _
"wurde erstellt !" & vbLf & vbLf & " "
Else
MsgBox "Verzeichnis: " & Chr(13) & Chr(13) & VerzOrd & Chr(13) & Chr(13) & _
"ist vorhanden !" & vbLf & vbLf & " "
End If
Kunden_Ordneranlegen = VerzOrd & "\" & VerzNam
End Function
Function createpdf(sBereich As String, sFile As String)
Dim sdruckbereich As String
sdruckbereich = ActiveSheet.PageSetup.PrintArea
ActiveSheet.PageSetup.PrintArea = sBereich
'----- neue Datei pdf ---------------------------
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=sFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
ActiveSheet.PageSetup.PrintArea = sdruckbereich
End Function
Public Sub KundenMail(sMailto As String, sAttachements As String)
Dim Mailadresse As String, Betreff As String
Dim olApp As Object
Set olApp = CreateObject("Outlook.Application")
Betreff = "Anbei die gewünschte(n) 'PDF' Datei(en) !"
With olApp.CreateItem(0)
.To = sMailto
.Subject = Betreff
' .Subject = VerzNam
.Attachments.Add sAttachements 'FileName
.Display
' .Send
End With
Set olApp = Nothing
End Sub