Mit OutMail.Attachments.Add mehrere Dateien anhäng

Pfad = "D:\PDF\ PDF_Speicher = Pfad & "Rechnung.pdf" PDF_Speicher2 = Pfad & "Erinnerung.pdf" OutMail.Subject = "Rechnung" OutMail.Body = " Inhalt" ' Anhang hinzufügen: OutMail.Attachments.Add PDF_Speicher '...und anzeigen OutMail.Display ' Objekte sauber auflösen Set OutMail = Nothing Set OutApp = Nothing ' Tabelle schließen Application.DisplayAlerts = False

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Niclaus,
nachfolgend der Code. Bei Fragen - fragen!


Option Explicit
Private Sub NewZip(sPath)
'Leere ZipFile erstellen
If Len(Dir(sPath)) > 0 Then Kill sPath
Open sPath For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End Sub
Sub ZipFile()
Dim FileNameZip, SourceFolder
Dim strDate As String, DefPath As String
Dim oApp As Object
'Quell- und Zielpfad angeben
SourceFolder = Environ("userprofile") & "\Desktop\Test\" 'Hier Quell-Pfad der zu  _
komprimierenden Dateien anpassen
DefPath = Environ("userprofile") & "\Desktop\" 'Hier Ziel-Pfad anpassen. Achtung! Quell-  _
und Zielpfad dürfen nicht übereinstimmen!
'Dynamischen Namen für die Zip-Datei vergeben
strDate = Format(Now, " dd-mmm-yy h-mm-ss")
FileNameZip = DefPath & "ZipFiles " & strDate & ".zip" 'Name der Zip-Datei bei Bedarf  _
anpassen
'Leere Zip-File erstellen
NewZip (FileNameZip)
Set oApp = CreateObject("Shell.Application")
'Dateien aus SourceFolder in FileNameZip kopieren
oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(SourceFolder).Items
'Warten bis Komprimierung beendet ist
On Error Resume Next
Do Until oApp.Namespace(FileNameZip).Items.Count = _
oApp.Namespace(SourceFolder).Items.Count
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
End Sub

Gruß Rob

Private Sub NewZip(sPath) If Len(Dir(sPath)) > 0 Then Kill sPath Open sPath For Output As #1 Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0) Close #1 End Sub Sub ZipFile() Dim FileNameZip, SourceFolder Dim strDate As String, DefPath As String Dim oApp As Object SourceFolder = Environ("userprofile") & "\Desktop\Test\" DefPath = Environ("userprofile") & "\Desktop\" strDate = Format(Now, " dd-mmm-yy h-mm-ss") FileNameZip = DefPath & "ZipFiles " & strDate & ".zip" NewZip (FileNameZip) Set oApp = CreateObject("Shell.Application") oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(SourceFolder).Items On Error Resume Next Do Until oApp.Namespace(FileNameZip).Items.Count = _ oApp.Namespace(SourceFolder).Items.Count Application.Wait (Now + TimeValue("0:00:01")) Loop On Error GoTo 0 End Sub

Beliebteste Forumthreads (12 Monate)

Mit OutMail.Attachments.Add mehrere Dateien anhäng

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread