AW: pdf Datei unbenennen
09.04.2014 12:25:24
Tino
Hallo,
kannst mal diesen Code testen.
Bitte zuvor ausgiebig testen bevor du diesen Code auf die Original-Daten loslässt.
Pfad zur Textdatei und den PDF-Dateien anpassen!
In der Tabelle1 A:C wird ein ergebnis ausgegeben, evtl. Tabelle1 Code anpassen!
Sub Start()
Dim sFullPathTxT$, sPathPDF$, sDir$
Dim ArTxTInhalt
Dim ArErgebnis()
Dim n&, nn&, nnn&
'Pfad wo die Textdatei liegt
sFullPathTxT = "C:\Ordner\PDF\kddateine.txt"
'Ordner wo die PDF Dateien liegen
sPathPDF = "C:\Ordner\PDF\"
sPathPDF = IIf(Right$(sPathPDF, 1) = "\", sPathPDF, sPathPDF & "\")
ArTxTInhalt = LeseTextFile(sFullPathTxT)
If IsArray(ArTxTInhalt) Then
Redim Preserve ArErgebnis(1 To Ubound(ArTxTInhalt) + 2, 1 To 3)
nn = 1: nnn = 1
ArErgebnis(nn, 1) = "Original Name"
ArErgebnis(nn, 2) = "Neuer Name"
ArErgebnis(nn, 3) = "Fehler"
ChDrive sPathPDF
ChDir sPathPDF
On Error Resume Next
For n = Lbound(ArTxTInhalt) To Ubound(ArTxTInhalt)
sDir = Dir$(sPathPDF & ArTxTInhalt(n) & "_VF_RECHNUNG_*.pdf", vbNormal)
If sDir <> "" Then
nn = nn + 1
ArErgebnis(nn, 1) = sDir
ArErgebnis(nn, 2) = n + 1 & "_" & ArTxTInhalt(n) & ".pdf"
Name sPathPDF & sDir As sPathPDF & ArErgebnis(nn, 2)
If Err.Number <> 0 Or Dir(sPathPDF & n + 1 & "_" & ArTxTInhalt(n) & ".pdf", vbNormal) = "" Then
nnn = nnn + 1
ArErgebnis(nnn, 3) = ArTxTInhalt(n)
ArErgebnis(nn, 1) = Empty
ArErgebnis(nn, 2) = Empty
nn = nn - 1
Err.Clear
End If
Else
nnn = nnn + 1
ArErgebnis(nnn, 3) = ArTxTInhalt(n)
End If
Next n
With Tabelle1 'Ausgabe für Info, evtl. Tabelle anpassen
.Columns("A:C").Delete
With .Range("A1").Resize(Ubound(ArErgebnis), Ubound(ArErgebnis, 2))
.NumberFormat = "@"
.Value = ArErgebnis
.Rows(1).Font.Bold = True
.EntireColumn.AutoFit
End With
End With
End If
End Sub
Function LeseTextFile(sFilename$)
Dim F%, sInhalt$
If Dir$(sFilename, vbNormal) <> "" Then
F = FreeFile
Open sFilename For Binary As #F
sInhalt = Space$(LOF(F))
Get #F, , sInhalt
Close
LeseTextFile = Split(sInhalt, vbCrLf)
Else
MsgBox "Text Datei" & vbCr & sFilename & vbCr & "nicht gefunden!"
End If
End Function
Gruß Tino
