vba - Move Directory and Sub Directories Based on Filtered Data

Question

I have a MS Access table that houses directory names in a table. Scott Reeves helped me with the code below to move files based on sql filter and move the files to a different directory. However, I need to be able to move the entire directory/sub directories based on DIR data in the table. So if the table has DIR1234, then I need to copy DIR name it’s searching in and move SUB DIR’s to the new destination. I tried to modify the code with fso.MoveFolder Source:=FromPath, Destination:=ToPath, but am only getting a subset of data in the immediate window and it’s not moving anything to my destination. My directories look like Dir1>YYYYMMDD>ABC123>ABC1233>ABD1333 where the code would need to move DIR’s based on the predefined table data DIR’s ABC123/ABC1233 along with the root DIR

Anyone have an idea how I can achieve this?

Sub MoveFolder()
'Move DIR and all Sub Dir to destination based off of table DIR Name   
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim mysource As String
Dim mydes As String
Dim mysql As String

mysql = "SELECT * from DIR_UPDATE"
mysource = "C:Test"
'Need to move DIR and Sub DIR's
mydes = "C:TestFromCode"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(mysource)
Set db = CurrentDb
Set rs = db.OpenRecordSet(mysql)

While Not rs.EOF
    sourceFile = mysource & rs!Dir
    destFile = mydes & rs!Dir
    'Debug.Print rs!Dir
    If Dir(sourceFile) <> "" Then 'If sourceFile exists, then Dir(sourceFile) will return it's name, otherwise empty string
        FileCopy sourceFile, destFile
        fso.MoveFolder Source:=mysource, Destination:=mydes
    Else
        Debug.Print mydes & rs!Dir
    End If
    rs.MoveNext
Wend
End Sub

question from:https://stackoverflow.com/questions/65927807/move-directory-and-sub-directories-based-on-filtered-data

Answer 1

Sub MoveFolder()
'move any directories with all their contents listed in DIR_UPDATE from the source folder to the destination folder
Dim objFSO As Object
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim sourceFolder As String
Dim destinationFolder As String
Dim mysql As String

mysql = "SELECT * from DIR_UPDATE"
sourceFolder = "C:Test"
destinationFolder = "C:TestFromCode" 'no Trailing 
'Thanks to Gustav Brock @ https://answers.microsoft.com/en-us/msoffice/forum/all/copying-folder-using-access-vba-runtime-error/3dd49304-a1c4-41c6-a53e-c52ab993a24f for this tip '

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set db = CurrentDb
Set rs = db.OpenRecordset(mysql)

While Not rs.EOF 'look for folders from DIR_UPDATE and move them from sourcefolder to destinationfolder
    DIR_UPDATEFolder = sourceFolder & rs!Dir '
    If Dir(DIR_UPDATEFolder, vbDirectory) <> "" Then 'must tell dir that sourceFolder is a directory
        objFSO.CopyFolder Source:=DIR_UPDATEFolder, destination:=destinationFolder '
    Else
        Debug.Print mydes & rs!Dir
    End If
    rs.MoveNext
Wend
End Sub