Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Neueste PDF finden und mailen

Betrifft: Neueste PDF finden und mailen von: Patrick
Geschrieben am: 08.11.2012 11:03:51

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

  

Betrifft: AW: Neueste PDF finden und mailen von: Rudi Maintaire
Geschrieben am: 08.11.2012 13:03:52

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


  

Betrifft: AW: Neueste PDF finden und mailen von: Patrick
Geschrieben am: 08.11.2012 14:33:22

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


  

Betrifft: AW: Neueste PDF finden und mailen von: Rudi Maintaire
Geschrieben am: 08.11.2012 14:42:47

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


  

Betrifft: AW: Neueste PDF finden und mailen von: Patrick
Geschrieben am: 08.11.2012 15:15:25

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


  

Betrifft: auf pdf einschränken von: Rudi Maintaire
Geschrieben am: 08.11.2012 16:07:33

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


  

Betrifft: AW: auf pdf einschränken von: Patrick
Geschrieben am: 09.11.2012 08:20:16

Hallo Rudi,

vielen Dank für deine Hilfe.
Nun funktioniert alles wie gewünscht.

Schönes Wochenende.

MfG

Patrick


  

Betrifft: AW: auf pdf einschränken von: Patrick
Geschrieben am: 09.11.2012 10:30:20

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


  

Betrifft: AW: auf pdf einschränken von: Rudi Maintaire
Geschrieben am: 12.11.2012 15:41:46

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


 

Beiträge aus den Excel-Beispielen zum Thema "Neueste PDF finden und mailen"