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