How to move folders and update an MS Access field in my table accordingly? - vba

Question

I need to create an MS Access Button like in script below
that moves subfolders of a folder to another folder and
update an MS Access field in my table (query) accordingly.
Any help would be highly appreciated!
Here is the image that describes my issue IN DETAILS:
Maybe it is possible to just update the script below.
Option Compare Database
Option Explicit
'Access constants
Private Const A_INCOMING_ORDERS = "a_Incoming_Orders"
Private Const q_20_Wait = "q_20_Wait"
Private Const q_20_ACT = "q_20_ACT"
Private Const order_int_ID = "order_int_ID"
Private Const order_stage = "order_stage"
'Folders
Private Const FLD_DOWNLOADS = "d:\==Orders1290\10-1-Downloads\"
Private Const FLD_WAIT = "d:\==Orders1290\10-2-0-Wait\"
Private Const FLD_WAIT_90 = "d:\==Orders1290\10-2-1-Wait_PSD-90\"
----------------------------------------------------------
Private Sub Ctl10_20___10_30_Click()
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
'Get all files in FLD_WAIT
Dim fileList As Object
Set fileList = CreateObject("Scripting.Dictionary")
Dim oFile As Object, baseName As String
For Each oFile In FSO.GetFolder(FLD_WAIT).Files
baseName = FSO.GetBaseName(oFile.Name)
If fileList.Exists(baseName) Then
MsgBox _
"Existing: " & fileList.Item(baseName) & vbLf & vbLf & _
"Duplicate: " & oFile.Path, vbExclamation, _
"Duplicate Found - while collecting file names in { FLD_WAIT }."
Else
fileList.Add baseName, oFile.Path
End If
Next
'Open Recordset
Dim rs As Recordset
On Error Resume Next
Set rs = CurrentDb.OpenRecordset(q_20_ACT)
If (Not Err.Number = 0) Then MsgBox Err.Description, vbCritical, "Recordset: " & q_20_ACT: Exit Sub
If (rs.BOF And Not rs.EOF) Then: MsgBox "No data in recordset!", vbCritical, "Recordset: " & q_20_ACT: Exit Sub
On Error GoTo 0
'Move files in query matching order_int_ID
Dim idName, dFolder As String, cont As Integer
While (Not rs.EOF)
idName = rs.Fields(order_int_ID).Value
If TypeName(idName) = "String" Then
If fileList.Exists(idName) Then
dFolder = FLD_PROCESS_PSD & "\" & idName
If FSO.FolderExists(dFolder) Then
cont = MsgBox( _
"{ FLD_PROCESS_PSD } already has a folder in it matching an { ORDER_INT_ID } of: " & idName & vbLf & vbLf & "Skip & continue with the next file?", vbOKCancel + vbExclamation, _
"While creating folders for { ORDER_INT_ID } files")
If cont = vbCancel Then Exit Sub
Else
FSO.CreateFolder dFolder
FSO.MoveFile fileList.Item(idName), dFolder & "\"
rs.Edit: rs.Fields(order_stage) = "3_in_ACTION": rs.Update
End If
Else
cont = MsgBox( _
"No files found in { FLD_WAIT } that match an { ORDER_INT_ID } of: " & idName & vbLf & vbLf & "Skip & continue with the next file?", vbOKCancel + vbExclamation, _
"While moving { ORDER_INT_ID } files")
If cont = vbCancel Then Exit Sub
End If
End If
rs.MoveNext
Wend
rs.Close
End Sub