Automatisierte Emailabfrage

Sub PDF_und_Senden_kv()
Dim DateiName As String
Dim W As Worksheet
Dim Outlook As Object
Dim OutlookMailItem As Object
Dim myAttachments As Object
Set W = Worksheets("KVsent")
DateiName = W.Range("C3") & W.Range("C11") & ".pdf"
Worksheets("Kostenvoranschlag").Range("C1:K44").ExportAsFixedFormat Type:=xlTypePDF, Filename:=DateiName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMailItem = OutlookApp.CreateItem(0)
Set myAttachments = OutlookMailItem.Attachments
With OutlookMailItem
.To = W.Range("C6") & ";" & W.Range("C7")
.CC = W.Range("C8")
.BCC = W.Range("C9")
.Subject = W.Range("C11")
.Body = W.Range("C15")
myAttachments.Add DateiName
.Display
End With
Set OutlookApp = Nothing
Set OutlookMailItem = Nothing
End Sub

Sub PDF_und_Senden_re()
Dim DateiName As String
Dim W As Worksheet
Dim Outlook As Object
Dim OutlookMailItem As Object
Dim myAttachments As Object
Set W = Worksheets("REsent")
DateiName = W.Range("C3") & W.Range("C11") & ".pdf"
Worksheets("Rechnung").Range("C1:K44").ExportAsFixedFormat Type:=xlTypePDF, Filename:=DateiName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMailItem = OutlookApp.CreateItem(0)
Set myAttachments = OutlookMailItem.Attachments
With OutlookMailItem
.To = W.Range("C6") & ";" & W.Range("C7")
.CC = W.Range("C8")
.BCC = W.Range("C9")
.Subject = W.Range("C11")
.Body = W.Range("C15")
myAttachments.Add DateiName
.Display
End With
Set OutlookApp = Nothing
Set OutlookMailItem = Nothing
End Sub

Sub Folder1_öffnen()
Dim Pfad As String
Pfad = ThisWorkbook.Sheets("overview").Range("A4")
Shell "explorer.exe /e, " & Pfad, vbMaximizedFocus
End Sub

Sub Folder2_öffnen()
Dim Pfad As String
Pfad = ThisWorkbook.Sheets("overview").Range("A5")
Shell "explorer.exe /e, " & Pfad, vbMaximizedFocus
End Sub

Sub Folder3_öffnen()
Dim Pfad As String
Pfad = ThisWorkbook.Sheets("overview").Range("A7")
Shell "explorer.exe /e, " & Pfad, vbMaximizedFocus
End Sub

Sub Folder4_öffnen()
Dim Pfad As String
Pfad = ThisWorkbook.Sheets("overview").Range("A7")
Shell "explorer.exe /e, " & Pfad, vbMaximizedFocus
End Sub

Function ZuletztGespeichert()
ZuletztGespeichert = _
ThisWorkbook.BuiltinDocumentProperties("last save time")
End Function

Sub close_save()
ActiveWorkbook.Close SaveChanges:=True
End Sub