On this page you can find example code to copy, move and delete files and folders.
There are three sections on this page :
1) Copy and Move files and folders
2) Delete files and folders
3) Special Folders
4) VBS script to clear the Temp folder
Copy and Move files and folders
Below are a few examples to copy and move files and folders.
For one file you can use the VBA Name and FileCopy function
and for entire folders or a lot of files use the other macro example's
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
Filesystemobject example code's
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
Delete files and folders
Sub DeleteExample1()
'You can use this to delete all the files in the folder Test
On Error Resume Next
Kill "C:\Users\Ron\Test\*.*"
On Error GoTo 0
End Sub
Sub DeleteExample2()
'You can use this to delete all xl? files in the folder Test
On Error Resume Next
Kill "C:\Users\Ron\Test\*.xl*"
On Error GoTo 0
End Sub
Sub DeleteExample3()
'You can use this to delete one xls file in the folder Test
On Error Resume Next
Kill "C:\Users\Ron\Test\ron.xls"
On Error GoTo 0
End Sub
Sub DeleteExample4()
'You can use this to delete the whole folder
'Note: RmDir delete only a empty folder
On Error Resume Next
Kill "C:\Users\Ron\Test\*.*" ' delete all files in the folder
RmDir "C:\Users\Ron\Test\" ' delete folder
On Error GoTo 0
End Sub
Sub Delete_Whole_Folder()
'Delete whole folder without removing the files first like in DeleteExample4
Dim FSO As Object
Dim MyPath As String
Set FSO = CreateObject("scripting.filesystemobject")
MyPath = "C:\Users\Ron\Test" '<< Change
If Right(MyPath, 1) = "\" Then
MyPath = Left(MyPath, Len(MyPath) - 1)
End If
If FSO.FolderExists(MyPath) = False Then
MsgBox MyPath & " doesn't exist"
Exit Sub
End If
FSO.deletefolder MyPath
End Sub
Sub Clear_All_Files_And_SubFolders_In_Folder()
'Delete all files and subfolders
'Be sure that no file is open in the folder
Dim FSO As Object
Dim MyPath As String
Set FSO = CreateObject("scripting.filesystemobject")
MyPath = "C:\Users\Ron\Test" '<< Change
If Right(MyPath, 1) = "\" Then
MyPath = Left(MyPath, Len(MyPath) - 1)
End If
If FSO.FolderExists(MyPath) = False Then
MsgBox MyPath & " doesn't exist"
Exit Sub
End If
On Error Resume Next
'Delete files
FSO.deletefile MyPath & "\*.*", True
'Delete subfolders
FSO.deletefolder MyPath & "\*.*", True
On Error GoTo 0
End Sub
SpecialFolders
How do I get the path of a special folder and open the folder ?
Sub GetSpecialFolder()
'Special folders are : AllUsersDesktop, AllUsersStartMenu
'AllUsersPrograms, AllUsersStartup, Desktop, Favorites
'Fonts, MyDocuments, NetHood, PrintHood, Programs, Recent
'SendTo, StartMenu, Startup, Templates
'Get Favorites folder and open it
Dim WshShell As Object
Dim SpecialPath As String
Set WshShell = CreateObject("WScript.Shell")
SpecialPath = WshShell.SpecialFolders("Favorites")
MsgBox SpecialPath
'Open folder in Explorer
Shell "explorer.exe " & SpecialPath, vbNormalFocus
End Sub
Sub VBA_GetSpecialFolder_functions()
'Here are a few VBA path functions
MsgBox Application.Path
MsgBox Application.DefaultFilePath
MsgBox Application.TemplatesPath
MsgBox Application.StartupPath
MsgBox Application.UserLibraryPath
MsgBox Application.LibraryPath
End Sub
Temp folder
Without code you can do this to open the temp folder
Start>Run
Enter %temp%
OK
Or use one of the two code examples
Sub GetTempFolder_1()
MsgBox Environ("Temp")
'Open folder in Explorer
Shell "explorer.exe " & Environ("Temp"), vbNormalFocus
End Sub
Sub GetTempFolder_2()
Dim FSO As Object, TmpFolder As Object
Set FSO = CreateObject("scripting.filesystemobject")
Set TmpFolder = FSO.GetSpecialFolder(2)
MsgBox TmpFolder
'Open folder in Explorer
Shell "explorer.exe " & TmpFolder, vbNormalFocus
End Sub
0 = The Windows folder contains files installed by the Windows operating sys
1 = The System folder contains libraries, fonts, and device drivers
VBS script to clear the Temp folder
It is smart to delete all files and folders in your temp folder at least once a week to avoid problems.
Important: Do this always after you reboot your system.
Manual you can use this to open the folder and then delete all files and folders in the Temp folder.
Start>Run
Enter %temp%
OK
But it is easier to use a vbs file on your desktop to do this.
A vbs file is a text file with script in it with a vbs extension.
You simply double click on the file then on your desktop and it will do all the work for you.
1) Open Notepad
2) Copy/Paste the script in Notepad
3) Save the file as DeleteTempFiles.txt
4) Change the extension from txt to vbs
Hope its usefull.
No comments:
Post a Comment