PDA

View Full Version : [SOLVED] VBA to create a folder and move



shiva_reshs
09-11-2018, 10:55 PM
Hi Everyone,

Am new to this forum and i am no expert in VBA but fair in finding codes and applying it into my work.

Am trying to achieve below objective but not successful sofar.

1) I have file with column A, B and C

A column = File Name
B column = Folder Name for each file

C1 = is the path where file to be saved.
C2 = is the path where files are currently stored

I need a code which will create folder(As per column B cell for each file) move the files (stored in C2 path) in it. If folder found, then just move the file and go to next file name. Do the process until last cell value in column A.

Please help.

Thanks

mancubus
09-12-2018, 05:15 AM
welcome to the forum

since C1 houses the destination folder why do you need the value in column B?
is it parent folder is in C1 and check the existence of the subfolder from C1 + ColB?

Paul_Hossler
09-12-2018, 08:05 AM
An example would help

shiva_reshs
09-13-2018, 07:25 PM
welcome to the forum

since C1 houses the destination folder why do you need the value in column B?
is it parent folder is in C1 and check the existence of the subfolder from C1 + ColB?


Yes, Parent folder is in C1 and B1 is the subfolder to be created.

mancubus
09-13-2018, 11:44 PM
Sub vbax_63628_create_folders_move_files()

Dim prntfldr As String, srcfldr As String, dstfldr As String
Dim i As Long

Worksheets("Sheet1").Select 'change Sheet1 to suit

prntfldr = Range("C1").Value & "\"
srcfldr = Range("C2").Value & "\"

With CreateObject("Scripting.FileSystemObject")
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
If Not .FolderExists(prntfldr & Range("B" & i).Value) Then .CreateFolder (prntfldr & Range("B" & i).Value)
.MoveFile srcfldr & Range("A" & i).Value, prntfldr & Range("B" & i).Value & "\" & Range("A" & i).Value
Next i
End With

End Sub


ps: backup your files first or copy all in a test folder then test the code.
pps: can be done using array(s) but this should work for you.

shiva_reshs
09-14-2018, 12:34 AM
Hi,

I tried with your code, am getting error "Run Time error '53: File not found
on below line


Sub vbax_63628_create_folders_move_files()
Dim prntfldr As String, srcfldr As String, dstfldr As String
Dim i As Long

Worksheets("Sheet1").Select 'change Sheet1 to suit

prntfldr = Range("C1").Value & "\"
srcfldr = Range("C2").Value & "\"

With CreateObject("Scripting.FileSystemObject")
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
If Not .FolderExists(prntfldr & Range("B" & i).Value) Then .CreateFolder (prntfldr & Range("B" & i).Value)
.MoveFile srcfldr & Range("A" & i).Value, prntfldr & Range("B" & i).Value & "\" & Range("A" & i).Value
Next i
End With
End Sub

Please advise

shiva_reshs
09-14-2018, 01:20 AM
Is that because of the file extension which is in .PDF?

shiva_reshs
09-14-2018, 03:14 AM
.MoveFile srcfldr & Range("A2" & i).Value & ".pdf", prntfldr & Range("B2" & i).Value & "\" & Range("A2" & i).Value & ".pdf"

Thanks, it was indeed pdf extension.

Working smooth now.

Thanks a lot mancubus

mancubus
09-14-2018, 04:56 AM
welcome.

yes. you should provide files' names with their extensions.