Anzeige
Archiv - Navigation
1284to1288
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Neueste PDF finden und mailen

Neueste PDF finden und mailen
08.11.2012 11:03:51
Patrick
Hallo Zusammen,
ich habe ein für mich zu umfangreiches VBA-Problem und hoffe von euch eine Lösung zu erhalten.
Ich möchte per VBA aus drei verschiedenen Verzeichnisses mir jeweils die neueste PDF-Datei als Anhang in eine Outlook-Mail einfügen lassen. Dort dann automatisiert Empfänger, Betreff und Text einfügen und versenden lassen.
Habe im Netz nur diesen Code zur Lösung eines Teils meines Problems gefunden:

Sub Rechteck1_BeiKlick()
Dim AktuellstesDatum As Date
Dim NeuesteDatei As String
Dim FS As Object
Dim Drv As Object
Dim Datei As Object
AktuellstesDatum = DateValue("1.1.1900")
NeuesteDatei = ""
Set FS = CreateObject("scripting.filesystemobject")
Set Drv = FS.GetFolder("Pfad")
For Each Datei In Drv.Files
If Datei.DateCreated > AktuellstesDatum Then
NeuesteDatei = Datei.Name
AktuellstesDatum = Datei.DateLastModified
End If
Next Datei
MsgBox NeuesteDatei
End Sub

Bekomme den Code nicht so angepasst, dass er die File in Outlook als Anhang einfügt und dann zum nächsten Verzeichnis wechselt und dort die selbe Prozedur wiederholt, um eine weitere Datei einzufügen.
Ich bin für jede Hilfe sehr dankbar und freue mich auf eure Antworten.
MfG
Patrick

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Neueste PDF finden und mailen
08.11.2012 13:03:52
Rudi
Hallo,
ungetestet:
Sub SendMessage()
Dim oOL As Object
Dim oOLMsg As Object
Dim oOLRecip As Object
Dim oOLAttach As Object
Dim arrAttach, vntAttach
arrAttach = GetAttachments
Set oOL = CreateObject("Outlook.Application")
Set oOLMsg = oOL.CreateItem(0)
With oOLMsg
Set oOLRecip = .Recipients.Add(Range("E1").Value)
For Each vntAttach In arrAttach
Set oOLAttach = .Attachments.Add(vntAttach)
Next
.Subject = Format(Date, "dd.mm.yy") & " - " & Format(Time, "hh:mm:ss")
.Body = "Beiliegend die PDF-Dateien"
.Send
End With
Set oOLRecip = Nothing
Set oOLMsg = Nothing
Set oOL = Nothing
End Sub
Function GetAttachments()
Dim AktuellstesDatum As Date
Dim arrAttach(2)
Dim arrPfad, i As Integer
Dim FS As Object
Dim Drv As Object
Dim Datei As Object
Set FS = CreateObject("scripting.filesystemobject")
arrPfad = Array("PfadA", "PfadB", "PfadC")
For i = 0 To 2
AktuellstesDatum = DateValue("1.1.1900")
Set Drv = FS.GetFolder(arrPfad(i))
For Each Datei In Drv.Files
If Datei.DateLastModified > AktuellstesDatum Then
arrAttach(i) = Datei
AktuellstesDatum = Datei.DateLastModified
End If
Next Datei
Next i
GetAttachments = arrAttach
End Function

Gruß
Rudi

Anzeige
AW: Neueste PDF finden und mailen
08.11.2012 14:33:22
Patrick
Hallo Rudi,
vielen Dank für die schnelle Antwort.
Habs mal getestet und bekomme folgende Fehlermeldung:
"Pfad nicht gefunden"
Set Drv = FS.GetFolder(arrPfad(i))
Den Pfad habe ich mehrfach überprüft und kann dort keine fehlerhafte Eingabe entdecken.
Ich bin nun ein wenig ratlos, wo der Fehler liegen könnte.
Pfade sind so eingegeben: N:\GHV\Disposition\Versandanmeldung\2012\
MfG
Patrick

AW: Neueste PDF finden und mailen
08.11.2012 14:42:47
Rudi
Hallo,
tatsächlich so?
arrPfad=Array("N:\GHV\Disposition\Versandanmeldung\2012\", "N:\GHV\Disposition\Test1\2012\","N:\GHV\Disposition\test2\2012\")
Überprüf mal arrPfad imLokalfenster.
Gruß
Rudi

Anzeige
AW: Neueste PDF finden und mailen
08.11.2012 15:15:25
Patrick
Hallo Rudi,
habe einfach noch Mal den Pfad komplett für alle 3 Verzeichnisse eingegeben und siehe da es funktioniert.
E-Mail-Versand klappt 1A. Er hat aber nun aus 2 Verzeichnissen ausgeblendete Dateien (Thumbs.db) als Anlage gewählt und versendet.
Kann man Excel irgendwie sagen, dass er nur PDF Files bei der Suche nach der zuletzt erstellten Datei beachten soll? Wenn das funktioniert wäre dein Code optimal :)
MfG
Patrick

auf pdf einschränken
08.11.2012 16:07:33
Rudi
Hallo,
klar geht das.
Function GetAttachments()
Dim AktuellstesDatum As Date
Dim arrAttach(2)
Dim arrPfad, i As Integer
Dim FS As Object
Dim Drv As Object
Dim Datei As Object
Set FS = CreateObject("scripting.filesystemobject")
arrPfad = Array("PfadA", "PfadB", "PfadC")
For i = 0 To 2
AktuellstesDatum = DateValue("1.1.1900")
Set Drv = FS.GetFolder(arrPfad(i))
For Each Datei In Drv.Files
If LCase(Datei.Name) Like "*.pdf" Then
If Datei.DateLastModified > AktuellstesDatum Then
arrAttach(i) = Datei
AktuellstesDatum = Datei.DateLastModified
End If
End If
Next Datei
Next i
GetAttachments = arrAttach
End Function

Gruß
Rudi

Anzeige
AW: auf pdf einschränken
09.11.2012 08:20:16
Patrick
Hallo Rudi,
vielen Dank für deine Hilfe.
Nun funktioniert alles wie gewünscht.
Schönes Wochenende.
MfG
Patrick

AW: auf pdf einschränken
09.11.2012 10:30:20
Patrick
Hallo Rudi,
muss jetzt leider noch Mal nachfragen. Eine Kollegin hat nun die zu suchenden Dateien noch auf Unterordner im Pfad verteilt und wird dort auch weiterhin neue PDF in verschiedene Unterordner (zB. November 2012, Dezemeber 2012 usw) speichern.
Habe per Google nur Codes wie .searchSubFolders = True bzw SubFolder = True gefunden, diese an versch. Stellen eingesetzt, doch ohne Erfolg.
Kann man eine Suche in Unterordnern unkompliziert in den Code einfügen? Falls dies nicht möglich ist, bitte nicht den Code umschreiben. So viel Aufwand will dich dir nicht zumuten. Werde dann monatlich den Pfad einfach anpassen.
Nochmals danke.
Ansonsten ein schönes Wochenende.
MfG
Patrick

Anzeige
AW: auf pdf einschränken
12.11.2012 15:41:46
Rudi
Hallo,
solange es nur eine Ebene ist:
Function GetAttachments()
Dim AktuellstesDatum As Date
Dim arrAttach(2)
Dim arrPfad, i As Integer
Dim FS As Object
Dim oSub As Object
Dim Drv As Object
Dim Datei As Object
Set FS = CreateObject("scripting.filesystemobject")
arrPfad = Array("PfadA", "PfadB", "PfadC")
For i = 0 To 2
AktuellstesDatum = DateValue("1.1.1900")
Set Drv = FS.GetFolder(arrPfad(i))
For Each Datei In Drv.Files
If LCase(Datei.Name) Like "*.pdf" Then
If Datei.DateLastModified > AktuellstesDatum Then
arrAttach(i) = Datei
AktuellstesDatum = Datei.DateLastModified
End If
End If
Next Datei
For Each oSub In Drv.subfolders
If LCase(Datei.Name) Like "*.pdf" Then
If Datei.DateLastModified > AktuellstesDatum Then
arrAttach(i) = Datei
AktuellstesDatum = Datei.DateLastModified
End If
End If
Next oSub
Next i
GetAttachments = arrAttach
End Function
Gruß
Rudi
Anzeige

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige