Microsoft Excel

Herbers Excel/VBA-Archiv

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

Datei suchen, kopieren, einfügen | Herbers Excel-Forum


Betrifft: Datei suchen, kopieren, einfügen von: Bruno
Geschrieben am: 21.10.2008 18:15:03

Guten Abend zusammen

Aus einem Ordner (PDF_Devis) mit in PDFs konvertierten EXCEL-Mappen möchte ich mittels VBA die zeitlich jüngste PDF-Datei auswählen, und in den Ordner «EMail» kopieren. Als VBA-Neuling habe ich damit erhebliche Probleme und hoffe auf Hilfe aus diesem Forum.

Gruss, Bruno

  

Betrifft: AW: Datei suchen, kopieren, einfügen von: Jürgen V.
Geschrieben am: 22.10.2008 17:03:22

Hallo Bruno,

so sollte es gehen. Die Pfade musst Du noch auf Deine Erfordernisse anpassen.

Sub JuengstesPDFkopieren()
Dim FSO As Object
Dim objDatei As Object
Dim Dateiname As String
Dim Verzeichnisname As String
Dim juengstesDatum As Date

Verzeichnisname = "c:\PDF_Devis\"
juengstesDatum = DateValue("01.01.1900")

Set FSO = CreateObject("Scripting.FileSystemObject")
For Each objDatei In FSO.getfolder(Verzeichnisname).Files
   If UCase(Right(objDatei.Name, 4)) = ".PDF" Then
      If objDatei.datelastmodified > juengstesDatum Then
         juengstesDatum = objDatei.datelastmodified
         Dateiname = objDatei.Name
      End If
   End If
Next

If Dateiname <> "" Then
   FSO.getfile(Verzeichnisname & Dateiname).Copy ("c:\EMail\")
   MsgBox "Dateiname: " & Dateiname & " kopiert"
Else
   MsgBox "Keine PDF-Datei gefunden"
End If

Set FSO = Nothing
End Sub




Gruß, Jürgen


  

Betrifft: AW: Datei suchen, kopieren, einfügen von: Bruno
Geschrieben am: 22.10.2008 23:42:08

Guten Abend Jürgen

Dein Code funktioniert nach meinen Vorstellungen, vielen Dank für deine Unterstützung. Ich habe ihn in ein bereits bestehendes (von meinem Vorgänger übernommenes) Makro eingebaut (JuengstesPDFkopieren):

Public Sub ToolbarEMailIt()
Dim d As String
Dim i As Integer
Dim r As Integer

  On Error GoTo ToolbarEMailIt_Error
  DoScanSheets
  Application.Goto "EMail"
  JuengstesPDFkopieren

  d = Trim$(ActiveCell.Value)
  If Right$(d, 1) <> "\" Then d = d + "\"
  
  ActiveWorkbook.SaveCopyAs d + ActiveWorkbook.Name                 
  For i = LBound(PrDoc) To UBound(PrDoc)
    If PrDoc(i) <> "" Then
      If Dir$(PrDoc(i)) <> "" Then
        FileCopy PrDoc(i), d + ExtractFileName(PrDoc(i))
      Else
        PrDoc(i) = ""
        MsgBox "Zeichnungsdatei " & PrDoc(i) & " nicht gefunden", vbExclamation, "Meldung"
      End If
    End If
  Next
  
  r = MsgBox("Devis für eMail-Versand zusammenstellen", vbQuestion + vbYesNo, "Nachfrage:")
  If r = vbYes Then OutLookMail d + ActiveWorkbook.Name, PrDoc    
  
ToolbarEMailIt_Exit:
  Exit Sub
ToolbarEMailIt_Error:
  MsgBox Error$
  Resume ToolbarEMailIt_Exit
  
End Sub



Allerdings werde ich die (jetzt durch das PDF ersetzte) bisher versandte Excelmappe nicht los, sie wird mit vorstehender Prozedur generiert und muss nun noch manuell in Outlook gelöscht werden. Kann der bestehende Code eventuell so modifiziert werden, dass die aktive Mappe nicht an Outlook und den Email-Ordner übergeben wird, sondern nur die als PDF konvertierte Mappe (letztere befindet sich im Verzeichnis «PFD_Devis») und die zugehörigen Zeichnungen im PDF-Format (aus dem Verzeichnis «Zeichnungen»)?

Gruss, Bruno


  

Betrifft: AW: Datei suchen, kopieren, einfügen von: Jürgen V.
Geschrieben am: 25.10.2008 00:17:13

Hallo Bruno,

über weite Teile Deines Codes kann ich nur Vermutungen anstellen, z.B. was DoScanSheets anstellt, woher PrDoc stammt und was es enthält oder warum die aktive Zelle (und nicht eine bestimmte) ausgelesen wird und was drinsteht. Da zudem die bestehende Lösung komplex und mit Außenwirkung (E-Mail) verbunden zu sein scheint, halte ich mich mit meinen Mutmaßungen und Codevorschlägen zurück und rate Dir, kurzfristig einen Kollegen mit entsprechendem VBA-Wissen zu Rate zu ziehen und langfristig Dein VBA-Wissen auszubauen.

Ein paar Hinweise und Vorschläge hätte ich allerdings schon: Das Abspeichern der aktuellen Datei erfolgt mit ActiveWorkbook.SaveCopyAs d + ActiveWorkbook.Name - wenn Du das unterbinden möchtest, kannst Du die Zeile mit einem Hochkomma auskommentieren oder löschen. Wenn Du die soeben kopierte PDF-Datei anhängen möchtest, wirst Du Ihren Namen benötigen. Dazu kann man die Prozedur JuengstesPDFkopieren in eine Funktion umwandeln, die Dir den Dateinamen zurückliefert, z.B. so:

Function JuengstesPDFkopieren() as String
Dim FSO As Object
Dim objDatei As Object
Dim Dateiname As String
Dim Verzeichnisname As String
Dim juengstesDatum As Date

Verzeichnisname = "c:\PDF_Devis\"
juengstesDatum = DateValue("01.01.1900")

Set FSO = CreateObject("Scripting.FileSystemObject")
For Each objDatei In FSO.getfolder(Verzeichnisname).Files
If UCase(Right(objDatei.Name, 4)) = ".PDF" Then
If objDatei.datelastmodified > juengstesDatum Then
juengstesDatum = objDatei.datelastmodified
Dateiname = objDatei.Name
End If
End If
Next

If Dateiname <> "" Then
FSO.getfile(Verzeichnisname & Dateiname).Copy ("c:\EMail\")
End If

Set FSO = Nothing
JuengstesPDFkopieren = Dateiname

End Sub


Und Deinem Code würdest Du es so einbinden können:

PDFDateiname = JuengstesPDFkopieren()
If PDFDateiname = "" then
MsgBox "PDF-Datei " & PDFDateiname & " nicht gefunden!"
Goto ToolbarEMailIt_Exit
End if

Allerdings kann es dann später nicht heißen

If r = vbYes Then OutLookMail d + ActiveWorkbook.Name, PrDoc

sondern wahrscheinlich

If r = vbYes Then OutLookMail PDFDateiname, PrDoc

Achtung: damit geht die Dynamisierung verloren, die der Ersteller mit dem Auslesen der aktiven Zelle in Variable "d" vorgesehen hatte.

Ich hoffe, ich konnte Dir wenigstens ein wenig weiterhelfen.

Gruß, Jürgen


Beiträge aus den Excel-Beispielen zum Thema "Datei suchen, kopieren, einfügen"