How to create a folder with query conditions (1 Viewer)

Option Compare Database

Function Copy_Some_files()
    Dim db                    As DAO.Database
    Dim rs                    As DAO.Recordset
    Dim sSQL                  As String
    Dim i                     As Long
 
    Set db = CurrentDb
    
    sSQL = " SELECT Numero, Matr" & _
           " FROM Decisions" & _
           " Where Numero > '999'"
          Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot)
    With rs
        If rs.RecordCount = 0 Then
            MsgBox "No files to transfer"
        Else
            Do While Not .EOF
                FromPath = "C:\Decisions\"
                ToPath = "C:\Pers\"
                FileExt = ".pdf"
                FromPath = FromPath & !Numero & FileExt
                If Dir(FromPath) = "" Then
                    MsgBox FromPath & " doesn't exist"
                Else
                    ToPath = ToPath & !Matr & "\"
                    If Dir(ToPath) = "" Then
                        MkDir ToPath
                    End If
                    FileCopy FromPath, ToPath & !Numero & FileExt
                    .MoveNext
                End If
            Loop
            MsgBox "Files transferred from C:\Decisions to C:\Pers"
        End If
    End With
    rs.Close
    Set rs = Nothing
    Set db = Nothing
End Function

…
…
               Else
                    [COLOR="Blue"]ToPath = ToPath & !Matr[/COLOR]
                    If Dir(ToPath[COLOR="blue"], vbDirectory[/COLOR]) = "" Then
                        MkDir ToPath
                    End If
                    [COLOR="blue"]ToPath = ToPath & "\"[/COLOR]
 …
…

Option Compare Database

Sub Copy_Certain_Files_In_Folder()

    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String
    Dim db                    As DAO.Database
    Dim rs                    As DAO.Recordset
    Dim sSQL                  As String
    Dim Fnom As String
  
    Set db = CurrentDb
    
    sSQL = " SELECT Numero, Matr " & _
           " FROM Decisions" & _
           " Where VAL(Numero) < 999"
      Fnom = Numero
      
      ' Numero = number1,2,3,4
      ' Matr = Name1,2,3,4
      
    Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot)
       With rs
        If rs.RecordCount = 0 Then
            MsgBox "No files to transfer"
        Else
            Do While Not .EOF
                FromPath = "C:\Decisions\"
                ToPath = "C:\Personnel\"
                FromPath = FromPath & !Numero

                    ToPath = ToPath & !Matr
                    If Dir(ToPath, vbDirectory) = "" Then
                    Debug.Print ToPath
                        MkDir ToPath
                    End If
                    ToPath = ToPath & "\"
                    FileCopy FromPath, ToPath & !Numero
                .MoveNext
      
            Loop
            MsgBox "Files transferred from C:\Doc to C:\Pers"
        End If
    End With

End Sub

       With rs
        If rs.RecordCount = 0 Then
            MsgBox "No files to transfer"
        Else
            Do While Not .EOF
                FromPath = "C:\Decisions\"
                ToPath = "C:\Personnel\"
                FromPath = FromPath & !Numero & ".pdf"
             If Dir(FromPath, vbDirectory) = "" Then
                  MsgBox FromPath & " Not present"
                 .MoveNext
           Else
                    ToPath = ToPath & !Matr & "\"
                    If Dir(ToPath, vbDirectory) = "" Then
                        MkDir ToPath
                    End If
                    FileCopy FromPath, ToPath & !Numero & ".pdf"
                    .MoveNext
               End If
            Loop
            MsgBox "Files transferred from C:\Doc to C:\Pers"
        End If
    End With

Private Sub btncopy_Click()
    Dim fso As Object
    Dim fromPath As String, toPath As String, strPath As String
    Dim fileExt As String, source As String, destination As String, strSql As String
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
 
    fromPath = "C:\Decisions"  '<< Changed
    toPath = "C:\Personnel"    '<< Changed
    fileExt = ".pdf"  '<< Changed

    'You can use *.* for all files or *.doc for Word files
 
    Set dbs = CurrentDb
    Set fso = CreateObject("Scripting.FileSystemObject")
 
    strSql = " SELECT Dec.Numero, Dec.Matr, Dec.NomName, Dec.NomNameMatr,Dec.debut, Dec.fin " & _
             " From DEC " & _
             " Where VAL(Numero) > 4000"
    Set rst = dbs.OpenRecordset(strSql, dbOpenSnapshot)
    With rst
        If .RecordCount <> 0 Then
            Do While Not .EOF
            i = i + 1
 
            strPath = toPath & "\" & !NomNameMatr
            If Len(Dir(strPath, vbDirectory)) = 0 Then
                MkDir strPath
            End If
            strPath = toPath & "\" & !NomNameMatr & "\Decisions\"
            If Len(Dir(strPath, vbDirectory)) = 0 Then
                MkDir strPath
            End If
 
            If Dir(fromPath & "\" & !Numero) & fileExt <> "" Then
            source = fromPath & "\" & !Numero & fileExt
            destination = toPath & "\" & !NomNameMatr & "\Decisions\"
            overwrite = True 'True = ecraser si le fichier existe deja
            Call fso.CopyFile(source, destination, overwrite)
            End If
            .MoveNext
            Loop
        End If
    End With
    rst.Close
    Set fso = Nothing
    Set rst = Nothing
    Set dbs = Nothing
End Sub