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....

Answer 1

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