Private Sub Create_Folder() 'CREATE FOLDER' Dim ToPath As String ToPath = ThisWorkbook.Worksheets("1").Range("A1").Value MkDir ToPath End Sub Sub Copy_One_File() FileCopy "C:\Users\Ron\SourceFolder\Test.xls", "C:\Users\Ron\DestFolder\Test.xls" End Sub Sub Move_Rename_One_File() 'You can change the path and file name' Name "C:\Users\Ron\SourceFolder\Test.xls" As "C:\Users\Ron\DestFolder\TestNew.xls" End Sub Sub Delete_One_File() 'You can change the path and file name' Kill "C:\Users\Ron\SourceFolder\Test.xls" End Sub 'Copy or move more files or complete folders' 'Note: Read the commented code lines in the code' Sub Copy_Folder() 'This example copy all files and subfolders from FromPath to ToPath' 'Note: If ToPath already exist it will overwrite existing files in this folder' 'if ToPath not exist it will be made for you' Dim FSO As Object Dim FromPath As String Dim ToPath As String FromPath = "C:\Users\Ron\Data" '<< Change' ToPath = "C:\Users\Ron\Test" '<< Change' 'If you want to create a backup of your folder every time you run this macro' 'you can create a unique folder with a Date/Time stamp.' 'ToPath = "C:\Users\Ron\" & Format(Now, "yyyy-mm-dd h-mm-ss").' If Right(FromPath, 1) = "\" Then FromPath = Left(FromPath, Len(FromPath) - 1) End If If Right(ToPath, 1) = "\" Then ToPath = Left(ToPath, Len(ToPath) - 1) End If Set FSO = CreateObject("scripting.filesystemobject") If FSO.FolderExists(FromPath) = False Then MsgBox FromPath & " doesn't exist" Exit Sub End If FSO.CopyFolder Source:=FromPath, Destination:=ToPath MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath End Sub Sub Move_Rename_Folder() 'This example move the folder from FromPath to ToPath' Dim FSO As Object Dim FromPath As String Dim ToPath As String FromPath = "C:\Users\Ron\Data" '<< Change' ToPath = "C:\Users\Ron\Test" '<< Change' 'Note: It is not possible to use a folder that exist in ToPath' If Right(FromPath, 1) = "\" Then FromPath = Left(FromPath, Len(FromPath) - 1) End If If Right(ToPath, 1) = "\" Then ToPath = Left(ToPath, Len(ToPath) - 1) End If Set FSO = CreateObject("scripting.filesystemobject") If FSO.FolderExists(FromPath) = False Then MsgBox FromPath & " doesn't exist" Exit Sub End If If FSO.FolderExists(ToPath) = True Then MsgBox ToPath & " exist, not possible to move to a existing folder" Exit Sub End If FSO.MoveFolder Source:=FromPath, Destination:=ToPath MsgBox "The folder is moved from " & FromPath & " to " & ToPath End Sub Sub Copy_Files_Dates() 'This example copy all files between certain dates from FromPath to ToPath' 'You can also use this to copy the files from the last ? days' 'If Fdate >= Date - 30 Then' 'Note: If the files in ToPath already exist it will overwrite' 'existing files in this folder' Dim FSO As Object Dim FromPath As String Dim ToPath As String Dim Fdate As Date Dim FileInFromFolder As Object FromPath = "C:\Users\Ron\Data" '<< Change' ToPath = "C:\Users\Ron\Test" '<< Change' If Right(FromPath, 1) <> "\" Then FromPath = FromPath & "\" End If If Right(ToPath, 1) <> "\" Then ToPath = ToPath & "\" End If Set FSO = CreateObject("scripting.filesystemobject") If FSO.FolderExists(FromPath) = False Then MsgBox FromPath & " doesn't exist" Exit Sub End If If FSO.FolderExists(ToPath) = False Then MsgBox ToPath & " doesn't exist" Exit Sub End If For Each FileInFromFolder In FSO.getfolder(FromPath).Files Fdate = Int(FileInFromFolder.DateLastModified) 'Copy files from 1-Oct-2006 to 1-Nov-2006 If Fdate >= DateSerial(2006, 10, 1) And Fdate <= DateSerial(2006, 11, 1) Then FileInFromFolder.Copy ToPath End If Next FileInFromFolder MsgBox "You can find the files from " & FromPath & " in " & ToPath End Sub Sub Copy_Certain_Files_In_Folder() 'This example copy all Excel files from FromPath to ToPath' 'Note: If the files in ToPath already exist it will overwrite' 'existing files in this folder' Dim FSO As Object Dim FromPath As String Dim ToPath As String Dim FileExt As String FromPath = "C:\Users\Ron\Data" '<< Change' ToPath = "C:\Users\Ron\Test" '<< Change' FileExt = "*.xl*" '<< Change 'You can use *.* for all files or *.doc for Word files' If Right(FromPath, 1) <> "\" Then FromPath = FromPath & "\" End If Set FSO = CreateObject("scripting.filesystemobject") If FSO.FolderExists(FromPath) = False Then MsgBox FromPath & " doesn't exist" Exit Sub End If If FSO.FolderExists(ToPath) = False Then MsgBox ToPath & " doesn't exist" Exit Sub End If FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath MsgBox "You can find the files from " & FromPath & " in " & ToPath End Sub Sub Move_Certain_Files_To_New_Folder() 'This example move all Excel files from FromPath to ToPath' 'Note: It will create the folder ToPath for you with a date-time stamp' Dim FSO As Object Dim FromPath As String Dim ToPath As String Dim FileExt As String Dim FNames As String FromPath = "C:\Users\Ron\Data" '<< Change' ToPath = "C:\Users\Ron\" & Format(Now, "yyyy-mm-dd h-mm-ss") _ & " Excel Files" & "\" '<< Change only the destination folder' FileExt = "*.xl*" '<< Change' 'You can use *.* for all files or *.doc for word files' If Right(FromPath, 1) <> "\" Then FromPath = FromPath & "\" End If FNames = Dir(FromPath & FileExt) If Len(FNames) = 0 Then MsgBox "No files in " & FromPath Exit Sub End If Set FSO = CreateObject("scripting.filesystemobject") FSO.CreateFolder (ToPath) FSO.MoveFile Source:=FromPath & FileExt, Destination:=ToPath MsgBox "You can find the files from " & FromPath & " in " & ToPath End Sub 'VBA Deleting All Files and Subfolders' Sub VBAF1_Delete_All_Files_and_Subfolders() 'Variable declaration' Dim sFolderPath As String Dim FSO As Object 'Define Folder Path' sFolderPath = "C:\VBAF1\Test\" 'Check if slash is added' If Right(sFolderPath, 1) = "\" Then 'If added remove it from the specified path' sFolderPath = Left(sFolderPath, Len(sFolderPath) - 1) End If 'Create FSO Object' Set FSO = CreateObject("Scripting.FileSystemObject") 'Check Specified Folder exists or not' If FSO.FolderExists(sFolderPath) Then 'Delete All Files' FSO.DeleteFile sFolderPath & "\*.*", True 'Delete All Subfolders' 'Change the code' FSO.DeleteFolder sFolderPath & "\*.*", True 'Remark Sample:' 'Sample Delete File in Folder Download "C:\Users\Downloads\"' 'FSO.DeleteFolder sFolderPath & "\*.*", True' 'Sample Delete Folder in Folder Download "C:\Users\Downloads\FOLDER1\"' 'FSO.DeleteFolder sFolderPath , True' End If End Sub
Preview:
downloadDownload PNG
downloadDownload JPEG
downloadDownload SVG
Tip: You can change the style, width & colours of the snippet with the inspect tool before clicking Download!
Click to optimize width for Twitter