Option Explicit
Const zvPfad As String = "C:\Warenkorb\Zu_Verkaufen\"
Const zkPfad As String = "C:\Warenkorb\Zu_Kaufen\"
Const vPfad As String = "C:\Warenkorb\Verkauft\"
Const gPfad As String = "C:\Warenkorb\Gekauft\"
Const charleft As Integer = 10
Const shortname As Long = 12
Const saledstat As Long = 17
Sub DoIt()
Dim arrFiles() As Variant
Dim i As Integer
On Error Resume Next
arrFiles = listfiles(zvPfad, zkPfad)
If Err.Number Then
Call MsgBox("leere oder falsche Ordner", vbExclamation, "Abbruch")
Exit Sub
End If
On Error GoTo 0
arrFiles = chkhits(arrFiles, shortname, saledstat, "Gekauft", zvPfad, gPfad)
arrFiles = chkhits(arrFiles, shortname, saledstat, "Verkauft", zkPfad, vPfad)
For i = LBound(arrFiles, 1) To UBound(arrFiles, 1)
If InStr(arrFiles(i, 1), ":\") > 0 Then _
Name arrFiles(i, 1) As arrFiles(i, 2)
Next i
End Sub
Private Function chkhits(aFiles As Variant, clTerm As Long, clHit As Long, _
strHit As String, fFolder As String, tFolder As String)
Dim x As Long
Dim aList() As Variant
Dim rngHit As Range
Dim clDiff As Long
Dim strName As String
aList = aFiles
clDiff = clHit - clTerm
With ActiveSheet.Columns(clTerm)
For x = LBound(aList, 1) To UBound(aList, 1)
If InStr(aList(x, 1), ":\") = 0 Then
Set rngHit = .Find(aList(x, 2), , -4163, 2)
If Not rngHit Is Nothing Then
If rngHit.Offset(, clDiff).Value <> strHit Then
strName = aList(x, 1)
aList(x, 1) = fFolder & strName
aList(x, 2) = tFolder & strName
End If
End If
End If
Next x
End With
chkhits = aList
End Function
Private Function listfiles(ByVal zk As String, vk As String)
Dim vaArray As Variant
Dim i As Integer
Dim s As Integer
Dim oFile As Object
Dim oFSO As Object
Dim oFolder As Object
Dim oFiles As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(zk)
Set oFiles = oFolder.Files
s = oFiles.Count
Set oFolder = oFSO.GetFolder(vk)
Set oFiles = oFolder.Files
s = s + oFiles.Count
If s = 0 Then Exit Function
ReDim vaArray(1 To s, 1 To 2)
For Each oFile In oFiles
i = i + 1
vaArray(i, 1) = oFile.Name
vaArray(i, 2) = Left(oFile.Name, charleft)
Next
Set oFolder = oFSO.GetFolder(zk)
Set oFiles = oFolder.Files
For Each oFile In oFiles
i = i + 1
vaArray(i, 1) = oFile.Name
vaArray(i, 2) = Left(oFile.Name, charleft)
Next
listfiles = vaArray
End Function