I have a list of folders in a source folder as follows
Source Drive
John Doe
Sub1
Sub2
Joe Bloggs
Sub1
Sub2
and a folder list as follows
Destination Drive
John Doe
Joe Bloggs
The names are determined by a subform with a list of names so the database knows the assignee name.. I am trying to get a button to
1. copy the files excluding folders from the source drive W: sub2 folder to the Destination Drive X: Assignee folder.. the code will loop through all the folders Source Drive and put them in the correct folders in Destination drive.
Here is my code so far.. i get no errors but no files move either.. I am probably going the wrong way about this but you can scream at me if it helps.
Private Sub Command351_Click()
Const Source = "\Source Drive\"
Const Destination = "\Destination Drive"
Const FieldName = "Assignee"
Dim SourcePath As String
Dim DestinationPath As String
Dim LoopFile As String
Dim FileExt() As String
Dim Doc_Folder As String
Dim DestFolder As String
Dim DestFolder2 As String
Dim DestFolder3 As String
Dim SourceFolder As String
Dim SourceFolder2 As String
Dim SourceFolder3 As String
Dim FName As String
Dim fso As Object
Dim rs As DAO.Recordset
Dim Foldername As String
Set rs = Me.assignesubform.Form.RecordsetClone
DestFolder = Environ("UserProfile") & Destination
DestFolder2 = DestFolder & "\" & "Job No" & " " & [Job Number] & " " & "-" & " " & Me!Job
DestFolder3 = DestFolder2 & "\" & rs.Fields(FieldName)
SourceFolder = Environ("UserProfile") & Source
SourceFolder2 = SourceFolder & "\" & rs.Fields(FieldName)
SourceFolder3 = SourceFolder2 & "\" & "Sub1\Sub2\"
FName = ".pdf"
Set fso = CreateObject("Scripting.FileSystemObject")
SourcePath = (SourceFolder3 & "\")
DestinationPath = (DestFolder3 & "\")
LoopFile = Dir(SourceFolder3 & "*.*")
Do While LoopFile <> ""
FileExt = Split(LoopFile, ".")
Select Case FileExt(UBound(FileExt))
Case "docx", "doc", "ppt", "pptx", "eddx"
Name SourceFolder3 & LoopFile As DestFolder3 & LoopFile
End Select
LoopFile = Dir
Loop
Me.Requery
Source Drive
John Doe
Sub1
Sub2
Joe Bloggs
Sub1
Sub2
and a folder list as follows
Destination Drive
John Doe
Joe Bloggs
The names are determined by a subform with a list of names so the database knows the assignee name.. I am trying to get a button to
1. copy the files excluding folders from the source drive W: sub2 folder to the Destination Drive X: Assignee folder.. the code will loop through all the folders Source Drive and put them in the correct folders in Destination drive.
Here is my code so far.. i get no errors but no files move either.. I am probably going the wrong way about this but you can scream at me if it helps.
Private Sub Command351_Click()
Const Source = "\Source Drive\"
Const Destination = "\Destination Drive"
Const FieldName = "Assignee"
Dim SourcePath As String
Dim DestinationPath As String
Dim LoopFile As String
Dim FileExt() As String
Dim Doc_Folder As String
Dim DestFolder As String
Dim DestFolder2 As String
Dim DestFolder3 As String
Dim SourceFolder As String
Dim SourceFolder2 As String
Dim SourceFolder3 As String
Dim FName As String
Dim fso As Object
Dim rs As DAO.Recordset
Dim Foldername As String
Set rs = Me.assignesubform.Form.RecordsetClone
DestFolder = Environ("UserProfile") & Destination
DestFolder2 = DestFolder & "\" & "Job No" & " " & [Job Number] & " " & "-" & " " & Me!Job
DestFolder3 = DestFolder2 & "\" & rs.Fields(FieldName)
SourceFolder = Environ("UserProfile") & Source
SourceFolder2 = SourceFolder & "\" & rs.Fields(FieldName)
SourceFolder3 = SourceFolder2 & "\" & "Sub1\Sub2\"
FName = ".pdf"
Set fso = CreateObject("Scripting.FileSystemObject")
SourcePath = (SourceFolder3 & "\")
DestinationPath = (DestFolder3 & "\")
LoopFile = Dir(SourceFolder3 & "*.*")
Do While LoopFile <> ""
FileExt = Split(LoopFile, ".")
Select Case FileExt(UBound(FileExt))
Case "docx", "doc", "ppt", "pptx", "eddx"
Name SourceFolder3 & LoopFile As DestFolder3 & LoopFile
End Select
LoopFile = Dir
Loop
Me.Requery