leemcder
05-31-2022, 06:46 AM
Hello, I am using this macro to find files and move them to a folder. The folder created uses the contents in column A as the folder name. I'd like the folder to now use column A and column B as the folder name. I've tried a few things and it hasn't work. Please can someone help. Thank you
Sub FindFilesAndMove() Dim MyFolder As String, MyFile As String, srchStr As String, DestFoldFull As String, FSO As Object, rCell As Range
Dim DestFold As String
Set FSO = CreateObject("Scripting.Filesystemobject")
MyFolder = "Y:\Accounts Conveyancing Shared\Populated completion documents\" '<<< change to suit
DestFold = "Y:\Accounts Conveyancing Shared\Completions\Auto completion packs\" '<<< change to suit
For Each rCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Cells
MyFile = Dir(MyFolder)
srchStr = rCell.Value & " - "
DestFoldFull = DestFold & rCell & "\"
MkDir DestFoldFull
Do While MyFile <> ""
If InStr(MyFile, srchStr) Then
FSO.MoveFile Source:=MyFolder & MyFile, Destination:=DestFoldFull & MyFile
End If
MyFile = Dir
Loop
Next rCell
MsgBox ("Pack Creation Successful")
End Sub
End Sub
Sub FindFilesAndMove() Dim MyFolder As String, MyFile As String, srchStr As String, DestFoldFull As String, FSO As Object, rCell As Range
Dim DestFold As String
Set FSO = CreateObject("Scripting.Filesystemobject")
MyFolder = "Y:\Accounts Conveyancing Shared\Populated completion documents\" '<<< change to suit
DestFold = "Y:\Accounts Conveyancing Shared\Completions\Auto completion packs\" '<<< change to suit
For Each rCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Cells
MyFile = Dir(MyFolder)
srchStr = rCell.Value & " - "
DestFoldFull = DestFold & rCell & "\"
MkDir DestFoldFull
Do While MyFile <> ""
If InStr(MyFile, srchStr) Then
FSO.MoveFile Source:=MyFolder & MyFile, Destination:=DestFoldFull & MyFile
End If
MyFile = Dir
Loop
Next rCell
MsgBox ("Pack Creation Successful")
End Sub
End Sub