Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Überprüfen ob pdf dat. vorhanden

Überprüfen ob pdf dat. vorhanden
22.03.2014 18:11:57
Can
Hallo Herbers VBA Gemeinde,
in "C:\Users\Home\Desktop\Test\"
Habe ich hunderte von Excel Dateien die ich einmal in der Woche mit FreePDF XP in PDF Dateien Konvertiere.
Nun fällt mir das zu einige Excel Dateien keine PDF Dateien erstellt wurden.
Kann man über VBA dies Kontrollieren Welche Excel Dateien nicht in PDF Konvertiert wurden ? wenn Kein PDF Datei zu einer Excel Datei vorhanden ist soll dies in den Ordner Neu Konvertieren vorschoben werden
Die Namen sind immer identisch zwischen PDF und Excel.
Beispiel: Hallo.xls = Hallo.Pdf
Bitte um Hilfe bin für jede Hinweis Dankbar
Viele Grüße

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Überprüfen ob pdf dat. vorhanden
22.03.2014 18:46:39
Tino
Hallo,
kannst mal testen.
Sub Find_Fehlende_PDF()
Dim sPfadExcel$, n&, sPfadPDF$, sDir$
Dim varPDF()
Dim strFehlt$
sPfadExcel = "C:\Daten\Excel\"
sPfadPDF = "C:\Daten\PDF\"
ChDrive sPfadExcel
ChDir sPfadExcel
sDir = Dir(sPfadExcel & "*.xls?", vbNormal)
If sDir = "" Then
MsgBox "keine Excel gefunden"
Exit Sub
End If
'Array groß genug erstellen
ReDim Preserve varPDF(1 To 1000000)
Do While sDir  ""
n = n + 1
varPDF(n) = Left$(sDir, InStrRev(sDir, ".")) & "pdf"
sDir = Dir()
Loop
ReDim Preserve varPDF(1 To n)
ChDrive sPfadPDF
ChDir sPfadPDF
If n > 0 Then
For n = LBound(varPDF) To n
If Dir(CStr(sPfadPDF & varPDF(n)), vbNormal) = "" Then
strFehlt = strFehlt & varPDF(n) & vbCrLf
End If
Next n
strFehlt = Left$(strFehlt, Len(strFehlt) - 1)
MsgBox strFehlt, Title:="PDF nicht gefunden!"
Else
MsgBox "alle gefunden!", vbInformation
End If
End Sub
Gruß Tino

Anzeige
AW: Überprüfen ob pdf dat. vorhanden
22.03.2014 19:14:44
Can
Hallo Tino,
vielen lieben Dank für die schnelle Hilfe. Das Makro listet mir alle PDF Dateien die nicht existieren.
wie kann ich nun das so Umbauen das dazugehörende .xls Dateien in die "neu "Konvertieren" Ordner" verschoben werden damit ich zu dieses Dateien die Fehlende PDF´s erstelle.
Herzliche Grüße

AW: Überprüfen ob pdf dat. vorhanden
22.03.2014 19:47:03
Tino
Hallo,
ok. versuche es mal damit.
Es wird für die fehlenden Dateien ein Ordner im Excel Pfad mit dem aktuellen Datum angelegt.
Ist dieser schon vorhanden, werden die Dateien darin gelöscht,
wenn diese nicht gerade verwendet werden.
Sub Find_Fehlende_PDF()
Dim sPfadExcel$, n&, sPfadPDF$, sDir$, sNeuerOrdner$
Dim varPDF(), varExcel()
Dim strFehlt$, nCountF&, nCount&
sPfadExcel = "C:\Daten\Excel\"
sPfadPDF = "C:\Daten\PDF\"
ChDrive sPfadExcel
ChDir sPfadExcel
sDir = Dir(sPfadExcel & "*.xls?", vbNormal)
If sDir = "" Then
MsgBox "keine Excel gefunden"
Exit Sub
End If
'Array groß genug erstellen
ReDim Preserve varPDF(1 To 1000000)
ReDim Preserve varExcel(1 To 1000000)
Do While sDir  ""
n = n + 1
varExcel(n) = sDir
varPDF(n) = Left$(sDir, InStrRev(sDir, ".")) & "pdf"
sDir = Dir()
Loop
ReDim Preserve varExcel(1 To n)
ReDim Preserve varPDF(1 To n)
ChDrive sPfadPDF
ChDir sPfadPDF
If n > 0 Then
sNeuerOrdner = NeuerOrdner(sPfadExcel, Format(Date, "dd_mm_yyyy"))
On Error Resume Next
For n = LBound(varPDF) To n
If Dir(CStr(sPfadPDF & varPDF(n)), vbNormal) = "" Then
nCount = nCount + 1
FileCopy sPfadExcel & varExcel(n), sNeuerOrdner & varExcel(n)
If Err.Number  0 Then
nCountF = nCountF + 1
strFehlt = strFehlt & varExcel(n) & vbCrLf
Err.Number = 0
End If
End If
Next n
If nCountF > 0 Then
strFehlt = Left$(strFehlt, Len(strFehlt) - 1)
MsgBox nCountF & " Dateien konnten nicht kopiert werden!" & vbCr & vbCr & _
strFehlt, Title:="PDF nicht gefunden!"
End If
MsgBox nCount - nCountF & " Dateien wurden in den Ordner" & vbCr & vbCr & _
sNeuerOrdner & vbCr & vbCr & _
"kopiert!"
Else
MsgBox "alle gefunden!", vbInformation
End If
End Sub
Function NeuerOrdner(strPath$, OrdnerName$)
Dim s As String
On Error Resume Next
MkDir "" & strPath & OrdnerName & ""
NeuerOrdner = strPath & OrdnerName
NeuerOrdner = NeuerOrdner & IIf(Right$(NeuerOrdner, 1) = "\", "", "\")
If Err.Number  0 Then Kill NeuerOrdner & "*.*"
End Function
Gruß Tino

Anzeige
AW: Überprüfen ob pdf dat. vorhanden
22.03.2014 20:00:23
Can
Lieber Tino,
vielen vielen dank. Du hast mein neue bevorstehende Arbeitswoche gerettet.
DANKE
Herzliche Grüße

317 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige