Сверка имен PDF файлов с данными из Excel таблицы средствами Access VBA

Private Sub Befehl0_Click()
 
 
'ALLE Dateien aus dem Ordner fьr die 446471 LS lцschen*************************************************************************************************************************
 
Dim DirPath As String
Dim AllFilesMask As String
 
DirPath = "C:\Users\User\Desktop\LS\O2"
AllFilesMask = DirPath & "\*.*"
  
If Len(Dir(AllFilesMask)) > 0 Then
      Kill AllFilesMask
    End If
 
 
'Dateien im Ordner finden  -  mit dem Datum vom Vortag - alle Kunden in Sittensen, nicht nur 446471*************************************************************************************************************************
 
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsT As DAO.Recordset
Dim DatVortag As String
Dim N As String
 
Dim strDirPathOLD As String
Dim strDirPathNEW As String
Dim strMaskSearch As String
Dim strFileName As String
 
Set db = CurrentDb
Set rs = db.OpenRecordset("0000_Tage3", dbOpenDynaset)
Set rsT = db.OpenRecordset("NM1", dbOpenDynaset)
DatVortag = rs!DT
 
strDirPathOLD = "C:\Users\User\Desktop\LS\O1\"
strDirPathNEW = "C:\Users\User\Desktop\LS\O2\"
strMaskSearch = "*" & DatVortag & "*.PDF*"
 
strFileName = Dir(strDirPathOLD & strMaskSearch)
 
'von dem was das Programm gefunden hat - nur 446471 nehmen und in den anderen Ordner rьberkopieren************************************************************************************************************
 
Do While strFileName <> ""
MsgBox strFileName
                                            With rsT
                                                            Do Until .EOF = True
                                                                        N = rsT!NM
                                                                                      If N = strFileName Then
                                                                                                   FileCopy strDirPathOLD & strFileName, strDirPathNEW & strFileName
                                                                                      Else
                                                                                      End If
                                                                                      
                                                              .MoveNext
                                                            Loop
                                            End With
    strFileName = Dir
    
Loop
End Sub

Do While strFileName <> ""
MsgBox strFileName
    With rsT
        .findfirst "NM='" & strFileName & "'"
        if NOT .nomatch then
              FileCopy strDirPathOLD & strFileName, strDirPathNEW & strFileName
        end if
    End With
    strFileName = Dir
    
Loop

strFileName = Dir(strDirPathOLD & strMaskSearch)
 
    Do While strFileName <> ""
        MsgBox strFileName
        With rsT
            Do Until .EOF = True
                N = rsT!NM
                If N = strFileName Then
                    FileCopy strDirPathOLD & strFileName, strDirPathNEW & strFileName
                Else
                End If
                              
              .MoveNext
            Loop
        End With
        rsT.MoveFirst 'Возврат в начало! (zuruck!)
        strFileName = Dir
    Loop