PDF Dateien aus Verzeichnis automatisch per Email versenden

FOLDER_PDF = "C:\temp\source"  
FOLDER_MOVE = "C:\Temp\target"  
PATH_BLAT = "D:\Download\Blat\blat.exe"  

Set fso = WScript.CreateObject("Scripting.Filesystemobject")  
strPDFs = ""  
For Each file In fso.GetFolder(FOLDER_PDF).Files
	If LCase(fso.GetExtensionName(file.Path)) = "pdf" Then  
		If strPDFs <> "" Then  
			strPDFs = strPDFs & ",""" & file.Path & """"   
		Else
			strPDFs = """" & file.Path & """"   
		End If
	End If
Next
If strPDFs <> "" Then  
	sendNewMailViaBlat "sender@mail.de","empfänger@mail.de","Neue PDFs eingetroffen","Im Anhang Ihre PDFs",strPDFs,"smtp.mailserver.de","SMTP-USERNAME","SMTP-PASSWORD"  
	
	'PDFs in einen anderen Ordner verschieben  
	For Each pdf In Split(strPDFs,",",-1,1)  
		pdf = Replace(pdf,"""","",1,-1,1)  
		fso.MoveFile pdf , FOLDER_MOVE & "\"  
	Next
	'Alternativ Wenn die Dateien gelöscht werden sollen:  
'	For Each pdf In Split(strPDFs,",",-1,1)  
'		pdf = Replace(pdf,"""","",1,-1,1)  
'		fso.DeleteFile pdf,True  
'	Next  
End If

Function sendNewMailViaBlat(strFrom,strTo,strSubject,strBody,strAttachments,strSMTPServer,strSMTP_USER,strSMTP_PASS)
    Set objShell = CreateObject("WScript.Shell")  
    objShell.Run """" & PATH_BLAT & """" & " -subject """ & strSubject & """ -body """ & strBody & """ -to " & strTo & " -f " & strFrom & " -server " & strSMTPServer & " -u """ & strSMTP_USER & """ -pw """ & strSMTP_PASS & """ -attach " & strAttachments ,0,True  
    set objShell = Nothing
End Function

FOLDER_PDF = "C:\temp\source"  
FOLDER_MOVE = "C:\Temp\target"  
PATH_BLAT = "D:\Download\Blat\blat.exe"  

Set fso = WScript.CreateObject("Scripting.Filesystemobject")  
For Each file In fso.GetFolder(FOLDER_PDF).Files
	If LCase(fso.GetExtensionName(file.Path)) = "pdf" Then  
		sendNewMailViaBlat "sender@mail.de","empfänger@mail.de","Neue PDFs eingetroffen","Im Anhang Ihre PDFs", file.Path,"smtp.mailserver.de","SMTP-USERNAME","SMTP-PASSWORD"  
		fso.MoveFile file.Path , FOLDER_MOVE & "\"  
	End If
Next
		
Function sendNewMailViaBlat(strFrom,strTo,strSubject,strBody,strAttachments,strSMTPServer,strSMTP_USER,strSMTP_PASS)
    Set objShell = CreateObject("WScript.Shell")  
    objShell.Run """" & PATH_BLAT & """" & " -subject """ & strSubject & """ -body """ & strBody & """ -to " & strTo & " -f " & strFrom & " -server " & strSMTPServer & " -u """ & strSMTP_USER & """ -pw """ & strSMTP_PASS & """ -attach """ & strAttachments & """" ,0,True  
    set objShell = Nothing
End Function

' -------------------------  
'Ordner in dem die PDF Dateien liegen  
FOLDER_PDF = "C:\temp\source"  
' Ordner in dem Unterordner mit Datum erstellt werden und die PDFs dort rein verschoben werden  
FOLDER_MOVE = "C:\Temp\target"  
'Pfad zur BLAT.exe  
PATH_BLAT = "D:\Ordner\Blat\blat.exe"  
' Mailserverdaten:  
SMTP_SENDER = "user@domain.de"  
SMTP_SERVER = "smtp.mailserver.de"  
SMTP_USERNAME = "USERNAME"  
SMTP_PASSWORD = "PASSWORD"  
' -------------------------  
Set fso = WScript.CreateObject("Scripting.Filesystemobject")  
strPDFs = ""  
For Each file In fso.GetFolder(FOLDER_PDF).Files
	If LCase(fso.GetExtensionName(file.Path)) = "pdf" Then  
		'für jedes PDF eine einzelene Mail veschicken  
		sendNewMailViaBlat SMTP_SENDER,"belege@modernsolution-Shop.de","Neuer Beleg","Im Anhang finden sie den Beleg als PDF", """" &  file.Path & """",SMTP_SERVER,SMTP_USERNAME,SMTP_PASSWORD  
		If strPDFs <> "" Then  
			strPDFs = strPDFs & ",""" & file.Path & """"   
		Else
			strPDFs = """" & file.Path & """"   
		End If
	End If
Next
If strPDFs <> "" Then  
	' Alle PDFs in einer Mail zusammenfassen und verschicken  
	sendNewMailViaBlat SMTP_SENDER,"info@modernsolution.de,xxx@xxx.de","Neue PDFs eingetroffen","Im Anhang Ihre PDFs",strPDFs,SMTP_SERVER,SMTP_USERNAME,SMTP_PASSWORD  
	
	'PDFs in einen Ordner mit  dem aktuellen Datum verschieben  
	For Each pdf In Split(strPDFs,",",-1,1)  
		pdf = Replace(pdf,"""","",1,-1,1)  
		dateFolder = FOLDER_MOVE & "\" & FormatDateTime(Now(),vbShortDate)  
		If Not fso.FolderExists(dateFolder) Then 
			fso.CreateFolder(dateFolder)
		End If
		fso.MoveFile pdf , dateFolder & "\"  
	Next
End If

Function sendNewMailViaBlat(strFrom,strTo,strSubject,strBody,strAttachments,strSMTPServer,strSMTP_USER,strSMTP_PASS)
    Set objShell = CreateObject("WScript.Shell")  
    objShell.Run """" & PATH_BLAT & """" & " -subject """ & strSubject & """ -body """ & strBody & """ -to " & strTo & " -f " & strFrom & " -server " & strSMTPServer & " -u """ & strSMTP_USER & """ -pw """ & strSMTP_PASS & """ -attach " & strAttachments ,0,True  
    set objShell = Nothing
End Function

FOLDER_PDF = "C:\temp\source"  
FOLDER_MOVE = "C:\temp\target"  
PATH_BLAT = "D:\Download\Blat\blat.exe"  

' Dictionary mit den Mailadressen und Kürzeln erstellen  
Set oDic = CreateObject("scripting.dictionary")  
oDic.Add "MM","maxmuster@domain.de"  
oDic.Add "HM","helenemuster@domain.de"  

Set fso = CreateObject("Scripting.Filesystemobject")  
For Each file In fso.GetFolder(FOLDER_PDF).Files
	If LCase(fso.GetExtensionName(file.Path)) = "pdf" Then  
		'Kuerzel ermitteln  
		kuerzel = UCase(Mid(fso.GetBaseName(file.Path),5))
		' Wenn Kürzel im Dictionary existiert dann sende Mail  
		If oDic.Exists(kuerzel) Then
			strMail = oDic.Item(kuerzel)
			sendNewMailViaBlat "sender@mail.de",strMail,"Neue PDFs eingetroffen","Im Anhang Ihre PDFs", file.Path,"smtp.mailserver.de","SMTP-USERNAME","SMTP-PASSWORD"  
			fso.MoveFile file.Path , FOLDER_MOVE & "\"  
		End If
	End If
Next
		
Function sendNewMailViaBlat(strFrom,strTo,strSubject,strBody,strAttachments,strSMTPServer,strSMTP_USER,strSMTP_PASS)
    Set objShell = CreateObject("WScript.Shell")  
    objShell.Run """" & PATH_BLAT & """" & " -subject """ & strSubject & """ -body """ & strBody & """ -to " & strTo & " -f " & strFrom & " -server " & strSMTPServer & " -u """ & strSMTP_USER & """ -pw """ & strSMTP_PASS & """ -attach """ & strAttachments & """" ,0,True  
    set objShell = Nothing
End Function

FOLDER_PDF = "quelle"  

PATH_BLAT = "pfad zu blat.exe"  

'Nach dem Versenden pdf in den neu erstellten ordner verschieben  
Dim objFSO, newDIR, neuName

'Eingabefenster für den neuen Ordner  
neuName = InputBox("Bitte neuen Ordnernamen eingeben: PDF´s werden nach dem versenden in diesen dann Verschoben ")  
if neuName = "" then WScript.Quit  

ziel="pfad_zu_neuem_ordner\" & neuName  

Set objFSO = CreateObject("Scripting.FileSystemObject")  

if objFSO.Folderexists(ziel) = false then

Set newDIR = objFSO.CreateFolder(ziel)

end if



' Dictionary mit den Mailadressen und Kürzeln erstellen  
Set oDic = CreateObject("scripting.dictionary")  
oDic.Add "MM","maxmustermann@mailserver.de"  
oDic.Add "SM","SabineMueller.de"  


Set fso = CreateObject("Scripting.Filesystemobject")  
For Each file In fso.GetFolder(FOLDER_PDF).Files
	If LCase(fso.GetExtensionName(file.Path)) = "pdf" Then  
		'Kuerzel ermitteln  
		kuerzel = UCase(Mid(fso.GetBaseName(file.Path),5))
		' Wenn Kürzel im Dictionary existiert dann sende Mail  
		If oDic.Exists(kuerzel) Then
			strMail = oDic.Item(kuerzel)
			sendNewMailViaBlat "sender@mail.de",strMail,"Neue PDFs eingetroffen","Im Anhang Ihre PDFs", file.Path,"smtp.mailserver.de","SMTP-USERNAME","SMTP-PASSWORD"  




        	fso.MoveFile file.Path , newDIR & "\"  
		End If
	End If
Next

Function sendNewMailViaBlat(strFrom,strTo,strSubject,strBody,strAttachments,strSMTPServer,strSMTP_USER,strSMTP_PASS)
    Set objShell = CreateObject("WScript.Shell")  
    objShell.Run """" & PATH_BLAT & """" & " -subject """ & strSubject & """ -body """ & strBody & """ -to " & strTo & " -f " & strFrom & " -server " & strSMTPServer & " -u """ & strSMTP_USER & """ -pw """ & strSMTP_PASS & """ -attach """ & strAttachments & """" ,0,True  
    set objShell = Nothing
End Function

Const FOLDER_PDF = "C:\temp\source\pdf"  
Const FOLDER_MOVE = "C:\Temp\target"  
Const PATH_BLAT = "D:\Blat\blat.exe"  
Const PATH_PDFTK = "D:\pdftk\pdftk.exe"       ' "https://www.pdflabs.com/tools/pdftk-the-pdf-toolkit"  

'Variablen  
Dim intPDFCount

'Objekte  
Set fso = CreateObject("Scripting.Filesystemobject")  
Set objShell = CreateObject("Wscript.Shell")  

'Prüfe ob PDF-Dateien im Ordner vorhanden sind  
For Each file In fso.GetFolder(FOLDER_PDF).Files
	If LCase(fso.GetExtensionName(file.Path)) = "pdf" Then  
		intPDFCount = intPDFCount + 1
	End If
Next
'Wenn PDF Datein vorhanden ...  
If intPDFCount > 0 Then
	'Datum was an das kombinierte PDF angehangen wird  
	strDate = Year(Date) & Month(Date) & Day(Date) & "_" & Hour(Now) & Minute(Now) & Second(Now)  
	'Pfad für das kombinierte PDF  
	strPathPDFCombined = FOLDER_MOVE & "\Änderungen_" & strDate & ".pdf"  
	'kombiniere die PDF-Dateien in ein einzelnes PDF  
	objShell.Run """" & PATH_PDFTK & """ """ & FOLDER_PDF & "\*.pdf"" cat output """ & strPathPDFCombined & """", 0, True  

	'Mail via Blat verschicken  
	sendNewMailViaBlat "sender@mail.de","empfänger@mail.de","Änderungen","Im Anhang ist das PDF mit den Änderungen!",strPathPDFCombined,"smtp.mailserver.de","SMTP-USERNAME","SMTP-PASSWORD"  
	
	'Einzelne PDF-Dateien löschen  
	fso.DeleteFile FOLDER_PDF & "\*.pdf",True  
End If

Function sendNewMailViaBlat(strFrom,strTo,strSubject,strBody,strAttachments,strSMTPServer,strSMTP_USER,strSMTP_PASS)
     objShell.Run """" & PATH_BLAT & """" & " -subject """ & strSubject & """ -body """ & strBody & """ -to " & strTo & " -f " & strFrom & " -server " & strSMTPServer & " -u """ & strSMTP_USER & """ -pw """ & strSMTP_PASS & """ -attach """ & strAttachments & """" ,0,True  
    set objShell = Nothing
End Function

objShell.Run """" & PATH_BLAT & """" & " -subject """ & strSubject & """ -body """ & strBody & """ -to " & strTo & " -f " & strFrom & " -server " & strSMTPServer & " -attach """ & strAttachments & """" ,0,True