bestanden verplaatsen

[paul.jacobs]

Ik heb de volgende uitdaging.
Ik wil alle bestanden uit een map kopiëren naar een andere map.
Ik heb een voorbeeld gemaakt zodat jullie hopelijk snappen wat ik bedoel.

Stap 1: alle regels van de Query ”data Query” moet worden gebruikt.
Stap 2: eerst moet er een map aangemaakt worden waar de bestanden naar toe moet.
Dit heb ik nu maar weet niet of dit de beste manier is:

If Dir("G:\Projecten\data" & [project], vbDirectory) = "" Then MkDir "G:\Projecten\data" & [project]
If Dir("G:\Projecten\data" & [project] & "\stap", vbDirectory) = "" Then MkDir "G:\Projecten\data" & [project] & "\stap"
If Dir("G:\Projecten\data" & [project] & "\stap" & [Id], vbDirectory) = "" Then MkDir "G:\Projecten\data" & [project] & "\stap" & [Id]

Stap 3: als er een of meer bestanden staan in de link in [map] dan moeten deze gekopieerd worden in de map die er net is aangemaakt.
Hopelijk kan iemand me helpen.

Alvast bedankt

 

[OctaFish]

Hiermee krijg je de mappen wel gemaakt denk ik.

Function CopyFiles()
Dim rst As DAO.Recordset
    Set rst = CurrentDb.OpenRecordset("Data")
    With rst
        Do While Not .EOF
            On Error Resume Next
            CreateFolder (!map.Value & IIf(Right(!map.Value, 1) <> "\", "\", ""))
            .MoveNext
        Loop
        .Close
    End With
End Function

Public Function CreateFolder(sFolder As String) As String
On Error GoTo ErrorHandler
Dim s As String
    s = GetPathOnly(sFolder)
    If Dir(s, vbDirectory) = "" Then
        s = CreateFolder(s)
        MkDir s
    End If
    CreateFolder = sFolder
    Exit Function
    
ErrorHandler:
    Exit Function
End Function

Public Function GetPathOnly(sPath As String) As String
    GetPathOnly = Left(sPath, InStrRev(sPath, "\", Len(sPath)) - 1)
End Function