[RESOLVED] VBA: Move files to sub folders based on values in excel

Hi everyone,

I am trying to automate a process using VBA.

I have a excel file updated with file name, provider name, year, quarter in different columns.
I want to move all the files listed to respective, *\provider_name\Year\Quarter sub-folders. Can you please help me with the VBA for this.

Also, can VBA create the folders, if like provider_name folder doesn't exist?

Thank you!

Quote:

---

Originally Posted by Arpitha22

Also, can VBA create the folders, if like provider_name folder doesn't exist?

Thank you!

---

Windows API SHCreateDirectoryEx will do that for you: https://docs.microsoft.com/en-us/win...tedirectoryexw

Quote:

---

This function creates a file system folder whose fully qualified path is given by pszPath. If one or more of the intermediate folders do not exist, they are created as well.

---

Note: Max-length is limited to 246 characters. If you need more, you need to do it recursively.
Note2: You're responsible to make sure, that DirectoryPath contains only legal characters.

you can also use the vba mkdir command to create a folder as long as the parent folder exists

in the forum, we try to help you to write code or fix problems we try not to do the whole thing for you

you can use the name statement to move files from one location to the specified folder

this is sample code, and i do not expect it to work as i do not have enough information

Code:

---

for each cel in range("a:a")        ' column with filename
    if isempty(cel) then exit for    ' finish on empty cel
    path = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(Range("a5").Offset(, 1).Resize(, 3))), "\")
    name cel as path & "\" & cel  ' will fail if path does not exist
next

---

this does not include any testing to see if any folders exist already, you need to specify the full path to the filename, or if the full path is included in the column then the path will have to be stripped from the filename, to rename

ideally post a workbook with some sample data, zip first and attach to post

Test

Thank you for your responses!

I tried the below code,

Code:

Sub move_subfolder()
Dim xRg As Range, xCell As Range
Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
Dim xSPathStr As Variant, xDPathStr As Variant
Dim xVal As String
Dim xperiod As String
Dim xq As String
Dim xprovider As String

On Error Resume Next
Set xRg = Application.InputBox("Please select the file name range:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
If xRg Is Nothing Then Exit Sub
xSPathStr = "C:\Users\test\Move files to Quarter folder\data"

For Each xCell In xRg
xVal = xCell(1, 1).Value
MsgBox "file name"
MsgBox xVal
xprovider = xCell(1, 6).Value
MsgBox "provider"
MsgBox xprovider
xq = xCell(1, 5).Value
MsgBox "quarter"
MsgBox xq
xperiod = Split(xCell(1, 4).Value, ", ")(1)
MsgBox "period"
MsgBox xperiod
xDPathStr = "C:\Users\test\Move files to Quarter folder" & xprovider & "" & xperiod & "" & xq & ""
MsgBox "Dpath"
MsgBox xDPathStr
If TypeName(xVal) = "String" And xVal <> "" Then
If Len(Dir(xDPathStr)) = 0 Then
MsgBox "checkign if directory exists"
MkDir xDPathStr
MsgBox "making directory"
Else
MsgBox "Dir Exists!"
End If
MsgBox "ready to copy"
FileCopy xSPathStr & xVal, xDPathStr
MsgBox "copy-sucess"
'Kill xSPathStr & xVal
End If
Next
End Sub



Issue: File is not getting moved to destination folder. I tested having message box, everything looks good without errors but file not moved.

Also, everytime i run with the same file, same path, every single time the message creating directory is seen, not sure, why scriptis not able to identify the same path and tries to create one.

Please let me know what is the error in the code.

Quote:

---

If Len(Dir(xDPathStr)) = 0 Then

---

you have to specify that you are checking for a directory

Code:

---

If Len(Dir(xDPathStr, vbdirectory)) = 0 Then

---

also you need to check each subfolder in turn
that is check each cell contains a subfolder, and that each one exists

Quote:

---

xDPathStr = "C:\Users\test\Move files to Quarter folder" & xprovider & "" & xperiod & "" & xq & ""

---

you need \ between each subfolder

Quote:

---

FileCopy xSPathStr & xVal, xDPathStr

---

you need to specify the filename for the destination

Quote:

---

Also, everytime i run with the same file, same path, every single time the message creating directory is seen, not sure, why scriptis not able to identify the same path and tries to create one.

---

see first item

name will just move files rather than copying

Quote:

---

If TypeName(xVal) = "String" And xVal <> "" Then

---

you do not need to check if xval is a string as you have dimensioned it as a string, so it can not be anything else
probably better to check if the cell is empty before assigning value to xval, ...... no filename, nothing to do


USE CODE TAGS WHEN POSTING CODE

Thank you, I have implemented the changes you recommended. But, I am unable to get to the code to loop through each subfolder if exists or not. Can you please help me with this piece of code.

Thank you for all the help! this group has been my teacher. I got my script working. The problem was, the folder name had space and hence it was not creating.