Create new folder with current date and move specif files to it

S

SantanaKRE8s

Board Regular
Joined
Jul 11, 2023
Messages
131
Office Version
  1. 365
Platform
  1. Windows
Can someone please help with this VBA, I want to create a new folder with the current date and then move specific files to the new folder.

Sub FSOMoveAllFiles()
Dim FSO As New FileSystemObject
Dim FromPath As String
Dim ToPath As String
Dim FileInFromFolder As Object

FromPath = "H:\Desktop"
MkDir "G:\Branches\VS-SpaceX\Benjamin\FABRINET_THF002\CANCELED POs\FBN CXL REQ" & " " & Format(Now(), "M-DD-YYYY") & ""
ToPath = "G:\Branches\VS-SpaceX\Benjamin\FABRINET_THF002\CANCELED POs\FBN CXL REQ" & " " & Format(Now(), "M-DD-YYYY") & ""

Set FSO = CreateObject("Scripting.FileSystemObject")

For Each FileInFromFolder In FSO.GetFolder(FromPath).Files
FileInFromFolder.Move ToPath
Next FileInFromFolder

End Sub
 

Attachments

  • 2024-04-29 11_51_18-Microsoft Visual Basic for Applications - CXL REQUEST_FBN.xlsm [break] - [...png
    2024-04-29 11_51_18-Microsoft Visual Basic for Applications - CXL REQUEST_FBN.xlsm [break] - [...png
    19.7 KB · Views: 20

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Sort by date Sort by votes
Your code implies you are using early binding for the filesystem object, which means you will need to be sure to select "Microsoft Scripting Runtime" from the Tools-> References menu.
1714416442202.png


Not tested.
VBA Code: 
Sub FSOMoveAllFiles()
    Dim FSO As New FileSystemObject 'early binding of FSO oject
    Dim FromPath As String
    Dim ToPath As String
    Dim FileInFromFolder As File
    Dim DateStr As String, FldrName As String, BasePath As String
    
    DateStr = Format(Now(), "M-DD-YYYY")
    FldrName = "FBN CXL REQ" & DateStr
    BasePath = "G:\Branches\VS-SpaceX\Benjamin\FABRINET_THF002\CANCELED POs\"
    FromPath = "H:\Desktop"
    
    If Not FSO.FolderExists(FromPath) Then
        Debug.Print "Folder '" & FromPath & "' does not exist"          'optional
        MsgBox "Folder '" & FromPath & "' does not exist", vbCritical   'optional
        Exit Sub
    End If
    
    If Not FSO.FolderExists(BasePath) Then
        Debug.Print "Folder '" & BasePath & "' does not exist"          'optional
        MsgBox "Folder '" & BasePath & "' does not exist", vbCritical   'optional
        Exit Sub
    End If
    
    ToPath = BasePath & FldrName
    
    If Not FSO.FolderExists(ToPath) Then
        FSO.CreateFolder ToPath
    End If
    
    For Each FileInFromFolder In FSO.GetFolder(FromPath).Files
        FileInFromFolder.Move ToPath
    Next FileInFromFolder
End Sub


(Tip: For future posts , please try to use code tags like I did above when posting code. It makes your code easier to read and copy.
www.mrexcel.com

How to Post Your VBA Code

Post your VBA code.
www.mrexcel.com www.mrexcel.com
)
 
Upvote 0
rlv01 said:
Your code implies you are using early binding for the filesystem object, which means you will need to be sure to select "Microsoft Scripting Runtime" from the Tools-> References menu.
View attachment 110712

Not tested.
VBA Code: 
Sub FSOMoveAllFiles()
    Dim FSO As New FileSystemObject 'early binding of FSO oject
    Dim FromPath As String
    Dim ToPath As String
    Dim FileInFromFolder As File
    Dim DateStr As String, FldrName As String, BasePath As String
  
    DateStr = Format(Now(), "M-DD-YYYY")
    FldrName = "FBN CXL REQ" & DateStr
    BasePath = "G:\Branches\VS-SpaceX\Benjamin\FABRINET_THF002\CANCELED POs\"
    FromPath = "H:\Desktop"
  
    If Not FSO.FolderExists(FromPath) Then
        Debug.Print "Folder '" & FromPath & "' does not exist"          'optional
        MsgBox "Folder '" & FromPath & "' does not exist", vbCritical   'optional
        Exit Sub
    End If
  
    If Not FSO.FolderExists(BasePath) Then
        Debug.Print "Folder '" & BasePath & "' does not exist"          'optional
        MsgBox "Folder '" & BasePath & "' does not exist", vbCritical   'optional
        Exit Sub
    End If
  
    ToPath = BasePath & FldrName
  
    If Not FSO.FolderExists(ToPath) Then
        FSO.CreateFolder ToPath
    End If
  
    For Each FileInFromFolder In FSO.GetFolder(FromPath).Files
        FileInFromFolder.Move ToPath
    Next FileInFromFolder
End Sub


(Tip: For future posts , please try to use code tags like I did above when posting code. It makes your code easier to read and copy.
www.mrexcel.com

How to Post Your VBA Code

Post your VBA code.
www.mrexcel.com www.mrexcel.com
)
Click to expand...

Thank you very much, looks good, I did have the Scripting selected, and I add the code. It does create a New folder like I wanted to, but its not moving the files to the new folder created. Below is a image of the files that I want to move. The excel wkbooks "CANCEL".xlsx" and "THF002.xlsx" are always the same name but the "FBN CXL REQ 04-29-2024" is a file that is created in a seperate module of this same wokbook and the only thing that changes is the date its always the current date when the macro is ran. Alos debuggin at the end.

1714420126670.png

1714420329455.png
 
Upvote 0
Add intermediate variables to the debugger watch window to observe them when you single-step your code through the process. That way you should be able to watch and see how the file move process goes.
1714421754532.png


For debug purposes, temporarily replace this:
VBA Code: 
    If Not FSO.FolderExists(ToPath) Then
        FSO.CreateFolder ToPath
    End If
    
    For Each FileInFromFolder In FSO.GetFolder(FromPath).Files
        FileInFromFolder.Move ToPath
    Next FileInFromFolder
with this:
VBA Code: 
    If Not FSO.FolderExists(ToPath) Then
        FSO.CreateFolder ToPath
    End If
    
    If Not FSO.FolderExists(ToPath) Then
        Debug.Print "Folder '" & ToPath & "' does not exist"          'optional
        MsgBox "Folder '" & ToPath & "' does not exist" & vbCr & vbCr & "Folder creation unsuccessful", vbCritical  'optional
        Exit Sub
    End If
    
    With FSO.GetFolder(FromPath)
        For Each FileInFromFolder In .Files
            Select Case MsgBox("The file which will be moved is:" & vbCrLf & vbCrLf _
                    & "'" & FileInFromFolder.Path & "'" & vbCrLf & vbCrLf _
                    & "The target folder is :" & vbCrLf & vbCrLf _
                    & "'" & ToPath & "'" & vbCrLf & vbCrLf _
                    & "Proceed?", vbOKCancel Or vbQuestion, "Debug Message")
                Case vbOK
                Case vbCancel
                    Exit Sub
            End Select
            FileInFromFolder.Move ToPath
        Next FileInFromFolder
    End With
 
Upvote 0
rlv01 said:
Add intermediate variables to the debugger watch window to observe them when you single-step your code through the process. That way you should be able to watch and see how the file move process goes.
View attachment 110720

For debug purposes, temporarily replace this:
VBA Code: 
    If Not FSO.FolderExists(ToPath) Then
        FSO.CreateFolder ToPath
    End If
   
    For Each FileInFromFolder In FSO.GetFolder(FromPath).Files
        FileInFromFolder.Move ToPath
    Next FileInFromFolder
with this:
VBA Code: 
    If Not FSO.FolderExists(ToPath) Then
        FSO.CreateFolder ToPath
    End If
   
    If Not FSO.FolderExists(ToPath) Then
        Debug.Print "Folder '" & ToPath & "' does not exist"          'optional
        MsgBox "Folder '" & ToPath & "' does not exist" & vbCr & vbCr & "Folder creation unsuccessful", vbCritical  'optional
        Exit Sub
    End If
   
    With FSO.GetFolder(FromPath)
        For Each FileInFromFolder In .Files
            Select Case MsgBox("The file which will be moved is:" & vbCrLf & vbCrLf _
                    & "'" & FileInFromFolder.Path & "'" & vbCrLf & vbCrLf _
                    & "The target folder is :" & vbCrLf & vbCrLf _
                    & "'" & ToPath & "'" & vbCrLf & vbCrLf _
                    & "Proceed?", vbOKCancel Or vbQuestion, "Debug Message")
                Case vbOK
                Case vbCancel
                    Exit Sub
            End Select
            FileInFromFolder.Move ToPath
        Next FileInFromFolder
    End With
Click to expand...
It debugs at this point after doing the replacement.

1714431183281.png
 
Upvote 0
It looks like you deleted too much code. Try this.
VBA Code: 
Sub FSOMoveAllFiles()
    Dim FSO As New FileSystemObject 'early binding of FSO oject
    Dim FromPath As String
    Dim ToPath As String
    Dim FileInFromFolder As File
    Dim DateStr As String, FldrName As String, BasePath As String
   
    DateStr = Format(Now(), "M-DD-YYYY")
    FldrName = "FBN CXL REQ" & DateStr
    BasePath = "G:\Branches\VS-SpaceX\Benjamin\FABRINET_THF002\CANCELED POs\"
    FromPath = "H:\Desktop"
   
    If Not FSO.FolderExists(FromPath) Then
        Debug.Print "Folder '" & FromPath & "' does not exist"        
        MsgBox "Folder '" & FromPath & "' does not exist", vbCritical  
        Exit Sub
    End If
   
    If Not FSO.FolderExists(BasePath) Then
        Debug.Print "Folder '" & BasePath & "' does not exist"       
        MsgBox "Folder '" & BasePath & "' does not exist", vbCritical 
        Exit Sub
    End If
   
    ToPath = BasePath & FldrName
   
    If Not FSO.FolderExists(ToPath) Then
        FSO.CreateFolder ToPath
    End If
   
    If Not FSO.FolderExists(ToPath) Then
        Debug.Print "Folder '" & ToPath & "' does not exist"          'optional
        MsgBox "Folder '" & ToPath & "' does not exist" & vbCr & vbCr & "Folder creation unsuccessful", vbCritical  'optional
        Exit Sub
    End If
   
    With FSO.GetFolder(FromPath)
        For Each FileInFromFolder In .Files
            Select Case MsgBox("The file which will be moved is:" & vbCrLf & vbCrLf _
                    & "'" & FileInFromFolder.Path & "'" & vbCrLf & vbCrLf _
                    & "The target folder is :" & vbCrLf & vbCrLf _
                    & "'" & ToPath & "'" & vbCrLf & vbCrLf _
                    & "Proceed?", vbOKCancel Or vbQuestion, "Debug Message")
                Case vbOK
                Case vbCancel
                    Exit Sub
            End Select
            FileInFromFolder.Move ToPath
        Next FileInFromFolder
    End With
End Sub
 
Upvote 0
One more thing.

Replace this line:
VBA Code: 
    ToPath = BasePath & FldrName

with this:
VBA Code: 
    ToPath = BasePath & FldrName & "\"
 
Upvote 0
rlv01 said:
One more thing.

Replace this line:
VBA Code: 
    ToPath = BasePath & FldrName

with this:
VBA Code: 
    ToPath = BasePath & FldrName & "\"
Click to expand...
Its looks like now its working actually with that message box is great the only thing is, its not moving the correct files. I would like to move 3 excel books, 2 of them ( CANCEL.xlsx & THF002.xlsx ) are the ones I use to generate the third one ( FBN CXL REQ 04-30-2024.xlsx ), which is always named the same but the date changes to the current date everytime I run the report. These three files are the only ones that I would like to move but currently its only moving this one CANCEL.xlsx.

1714517792434.png
 
Upvote 0
SantanaKRE8s said:
View attachment 110790
Click to expand...
DISREGARD PREVUIOUS MESSAGE PLEASE - Its looks like now its working actually with that message box is great the only thing is, its moving all files and I just needed to move the two files that I used to create the report ( CANCEL.xlsx & THF002.xlsx ) and the completed report which always has the same name but the date changes ( FBN CXL REQ 04-30-2024.xlsx ). Im not sure if we can add a skip button to the message box so that I can skip the ones i dont want to move or have it look for only excel files or this option which is the most simple one have it move just those three files, ( FBN CXL REQ 04-30-2024.xlsx, CANCEL.xlsx & THF002.xlsx )
 
Upvote 0
SantanaKRE8s said:
the only thing is, its moving all files
Click to expand...
Hmm. Probably a bad idea then to name your Subroutine "FSOMoveAllFiles", don't you think? :)
Try this
VBA Code: 
Sub FSOMoveAllFiles()
    Dim FSO As New FileSystemObject                   'early binding of FSO oject
    Dim FromPath As String, ToPath As String, FileInFromFolder As File, DateStr As String, FldrName As String, BasePath As String
    Dim MCnt As Long
    
    DateStr = Format(Now(), "M-DD-YYYY")
    FldrName = "FBN CXL REQ" & DateStr
    BasePath = "G:\Branches\VS-SpaceX\Benjamin\FABRINET_THF002\CANCELED POs\"
    FromPath = "H:\Desktop"
    
    If Not FSO.FolderExists(FromPath) Then
        Debug.Print "Folder '" & FromPath & "' does not exist"
        MsgBox "Folder '" & FromPath & "' does not exist", vbCritical
        Exit Sub
    End If
    
    If Not FSO.FolderExists(BasePath) Then
        Debug.Print "Folder '" & BasePath & "' does not exist"
        MsgBox "Folder '" & BasePath & "' does not exist", vbCritical
        Exit Sub
    End If
    
    ToPath = BasePath & FldrName
    
    If Not FSO.FolderExists(ToPath) Then
        FSO.CreateFolder ToPath
    End If
    
    If Not FSO.FolderExists(ToPath) Then
        Debug.Print "Folder '" & ToPath & "' does not exist"    'optional
        MsgBox "Folder '" & ToPath & "' does not exist" & vbCr & vbCr & "Folder creation unsuccessful", vbCritical    'optional
        Exit Sub
    End If
    
    With FSO.GetFolder(FromPath)
        For Each FileInFromFolder In .Files
            Debug.Print FileInFromFolder.Name
            Select Case Trim(Left(FileInFromFolder.Name, 12))
                Case "CANCEL.xlsx", "THF002.xlsx", "FBN CXL REQ"
                    FileInFromFolder.Move ToPath
                    MCnt = MCnt + 1
            End Select
        Next FileInFromFolder
    End With
    
    MsgBox MCnt & " files moved.", vbInformation
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
VBA to Move files to another folder
Replies
3
Views
272
SantanaKRE8s
S
N
  • Solved
VB Script to Read Cells in Column A and Check if Folder Exists and if So Copy if not display message and move onto next cell
Replies
2
Views
774
NBoudreault
N
Jambi46n2
  • Question Question
Copying Multiple Paths/Files/Folders to New Paths and Rename with VBA
Replies
3
Views
2K
sijpie
sijpie
J
  • Solved
move files to folder
Replies
5
Views
1K
JAVEDR
J
C
  • Solved
VBA listing folders, sub-folders & file names - modification required
Replies
5
Views
1K
NdNoviceHlp
NdNoviceHlp

Forum statistics

Threads
1,223,888
Messages
6,175,219
Members
452,619
Latest member
Shiv1198

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top