ich habe mehrere Ordner mit PDF's die eine bestimmte Namenskonvention einhalten.
Z.B: M_123456_00.pdf
M = Kürzel
Zahlen = Bezeichnung
00 = Index
Ich habe aber auch PDF's mit gleicher Bezeichnung und dem Index 01,02, 03 usw. Und ich möchte gerne das dier alten PDF's aus den Ordner verschoben werden in einen anderen (z.B. Archiv Ordner).
Ich habe es mir so gedacht:
PDF'S mit gleicher Bezeichnung nach Index vergleichen
PDF mit kleineren Index verschieben und PDF mit höherem Index im Ordner lassen.
Ansonsten wenn eine PDF mit der Bezeichnung nur einmalig vorhanden ist, dann soll sie im Ordner bleiben.
Ich habe dazu das hier, was bei der oben genannten Namenskonvetion jedoch nicht funktioniert:
Private Const Dateipfad_pdf_dateien As String = "C:..."
Private Const Dateipfad_archiv As String = "C:...Archiv"
Sub Pdf_archivieren()
Dim Dateiname As String, i As Integer
Dim Liste As Variant, x As Long
Dim Liste_archiv As Variant, y As Long
Dim NV As String, Weiter As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
ReDim Liste(x)
ReDim Liste_archiv(y)
Dateiname = Dir$(Dateipfad_pdf_dateien & "*.pdf")
Do While Dateiname ""
Weiter = True
ReDim Preserve Liste(x)
Liste(x) = Dateiname
x = x + 1
Dateiname = Dir$()
Loop
If Weiter = False Then Exit Sub
Weiter = False
For i = LBound(Liste) To UBound(Liste)
NV = Neueste_version(Liste(i))
If Liste(i) NV Then
Weiter = True
ReDim Preserve Liste_archiv(y)
Liste_archiv(y) = Liste(i)
y = y + 1
End If
Next i
If Weiter = False Then Exit Sub
For i = LBound(Liste_archiv) To UBound(Liste_archiv)
fso.MoveFile Dateipfad_pdf_dateien & Liste_archiv(i), _
Dateipfad_archiv & Liste_archiv(i)
Next i
End Sub
Public Function Neueste_version(Dateiname_vorgabe) As String
Dim c1 As Variant, c2 As Variant, Dateiname As String, DN As String, Dateiname_mem As _
String, Dateiname_alternativ As String, Nr_mem As Long, Nr2 As Long, Strg As String
DN = Left(Dateiname_vorgabe, (InStrRev(Dateiname_vorgabe, ".") - 1))
c1 = Split(DN, "_")
If UBound(c1) = 0 Then
Strg = Trim(DN)
Else
Strg = Trim(c1(0))
End If
Dateiname = Dir$(Dateipfad_pdf_dateien & "*.pdf")
Do While Dateiname ""
Dateiname_mem = Left(Dateiname, (InStrRev(Dateiname, ".") - 1))
c2 = Split(Dateiname_mem, "_")
If UBound(c2) = 0 Then
If LCase(Trim(c2(0))) = LCase(Strg) Then Dateiname_alternativ = Dateiname
GoTo Weiter
End If
Nr2 = CDbl(c2(1))
If LCase(Strg) = LCase(Trim(c2(0))) Then
If Nr2 > Nr_mem Then
Nr_mem = Nr2
Neueste_version = Dateiname
End If
End If
Weiter:
Dateiname = Dir$()
Loop
If Trim(Neueste_version) = "" Then Neueste_version = Dateiname_alternativ
End Function
Kann mir jemand weiter helfen bitte?
Liebe Grüße
Philipp