Create folder and moves all the xlsx file in the newly created folder

Question

I am new to VBA MACRO I want the macro to create a folder (SubFolder) then moves all the file to the newly created folder.

My codes

Sub create_move()

'Variable declaration
    Dim sFolderName As String, sFolder As String
    Dim sFolderPath As String, oFSO As Object
    Dim fromdir As String
    Dim todir As String
    Dim flxt As String
    Dim fname As String
    Dim fso As Object
       
    'Main Folder
    sFolder = "C:\Main\" 'Main Folder where macro excel is present
    
    'Folder Name
    sFolderName = "POL & POD Files" & " " & "-" & " " & Format(Now, "DD-MM-YYYY")
    
    'Folder Path
    sFolderPath = "C:\NewFolder\" & sFolderName 'New Folder
        
    'Create FSO Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    
    'Create Folder
    MkDir sFolderPath
    
'Move files

fromdir = "C:\Users\chariab\Desktop\POL-POD AutoExp\Extracted Files\"

todir = "sFolderName" & "sFolderPath" ' Newly created folder name and path

flxt = "*.xlsx"

fname = Dir(fromdir & flxt)

 If Len(fname) = 0 Then
 MsgBox "All Excel Files Moved" & fromdir
 
Exit Sub
End If


Set fso = CreateObject("Scripting.FileSystemObject")

fso.MoveFile Source:=fromdir & flxt, Destination:=todir

End Sub

This macro creates folder but does not move the files in it I get run time error 76 Path not found. When I debug I get an error on this line "fso.MoveFile Source:=fromdir & flxt, Destination:=todir"

My idea was like to first create a new folder so for that I made initial coding to create a new folder and then to move the files in that newly created folder so I gave "their = the variable name and path which I used to create the folder" but this is not working this code is creating new folder but not moving the files in them and getting error in this line "fso.MoveFile Source:=fromdir & flxt, Destination:=todir" saying path not found.

Some1 please help....

`flxt` is a string that contains the wildcard. it needs to be the exact filename you are getting with `fname = Dir(fromdir & flxt)` — braX, Oct 18 '20 at 13:00
there are multiple excel files in the folder so I gave flxt = "*.xlsx" — Sandy, Oct 18 '20 at 13:31
Then you need to loop thru them - plenty of examples on stack overflow of how to do that. — braX, Oct 18 '20 at 13:51
Does this answer your question? [Loop through files in a folder using VBA?](https://stackoverflow.com/questions/10380312/loop-through-files-in-a-folder-using-vba) — braX, Oct 18 '20 at 14:23
you are not able to build it in your code? why would that be? — braX, Oct 18 '20 at 14:32

giovanni-furia · Accepted Answer · 2020-10-19T12:35:01.780

0

Try this:

Option Explicit

Sub create_move2()
    'Variable declaration
    Dim oFSO As Object
    Dim curFile As Variant
    Dim fromdir As String
    Dim todir As String
    Dim fileExt As String
           
    fromdir = "C:\Users\chariab\Desktop\POL-POD AutoExp\Extracted Files\"
    todir = "C:\NewFolder\POL & POD Files - " & Format(Now, "DD-MM-YYYY") & "\"

    fileExt = "xlsx"  'move files with file extension
            
    'Create FSO Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    
    'Create Folder
    MkDir todir
    
    For Each curFile In oFSO.GetFolder(fromdir).Files  'loop thru each file in fromdir

        
        If Right(CStr(curFile.name), len(fileExt)) = fileExt Then        'move file if it matches
            Debug.Print "moving " & curFile.name
            curFile.Move todir
        End If
    Next curFile
    
    If Dir(todir & "\*." & fileExt) <> "" Then 'check and see if files moved
        MsgBox "moved files to " & todir
    Else
        MsgBox "no files moved"
    End If
    
    Set oFSO = Nothing
    
End Sub

edited Oct 19 '20 at 12:35

answered Oct 18 '20 at 17:03

giovanni-furia

16
2

Thanks, @Gregorio_Allegri this is perfect. – Sandy Oct 18 '20 at 17:17
I would be highly obliged if you could please look at one more case that is pending if you don't mind and if possible the case title is "Coloring blank cells of a column based on the value in another column" please help if you can. Thanks a lot again @ Gregorio_Allegri – Sandy Oct 18 '20 at 17:19
also I do not see the case you mentioned, can you link? – giovanni-furia Oct 18 '20 at 17:23
No, the earlier one is working fine this code is giving error on line " 'Create Folder MkDir todir" – Sandy Oct 18 '20 at 17:28
Case/Question title is "Coloring blank cells of a column based on value in another column" – Sandy Oct 18 '20 at 17:30
this code will return an error if todir is already created. To fix this, replace mkDir todir with: ````If (Dir$(todir, vbDirectory) = "") Then MkDir todir End If ```` – giovanni-furia Oct 18 '20 at 22:28

Create folder and moves all the xlsx file in the newly created folder

1 Answers1