INTELLIGENT WORK FORUMS FOR COMPUTER PROFESSIONALS
Log In
Come Join Us!
Are you a Computer / IT professional? Join Tek-Tips Forums!
- Talk With Other Members
- Be Notified Of Responses
To Your Posts
- Keyword Search
- One-Click Access To Your
Favorite Forums
- Automated Signatures
On Your Posts
- Best Of All, It's Free!
*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.
Posting Guidelines
Promoting, selling, recruiting, coursework and thesis posting is forbidden. Students Click Here
|
VBA Visual Basic for Applications (Microsoft) FAQ
VBA How To
File and Folder Procedures by Bowers74
Posted: 4 Sep 03 (Edited 8 May 04)
|
The following procedures demonstrate creating, copying, moving and deleting of files and folders using VBA:
I know it's long, but it's worth it! 
Let's start with the File Procedures
Check if a file exists
CODESub FileExists() Dim fso Dim file As String file = "C:\Test.xls" ' change to match the file w/Path Set fso = CreateObject("Scripting.FileSystemObject") If Not fso.FileExists(file) Then MsgBox file & " was not located.", vbInformation, "File Not Found" Else MsgBox file & " has been located.", vbInformation, "File Found" End If End Sub Copy a file if it exists
CODESub CopyFile() Dim fso Dim file As String, sfol As String, dfol As String file = "test.xls" ' change to match the file name sfol = "C:\" ' change to match the source folder path dfol = "E:\" ' change to match the destination folder path Set fso = CreateObject("Scripting.FileSystemObject") If Not fso.FileExists(sfol & file) Then MsgBox sfol & file & " does not exist!", vbExclamation, "Source File Missing" ElseIf Not fso.FileExists(dfol & file) Then fso.CopyFile (sfol & file), dfol, True Else MsgBox dfol & file & " already exists!", vbExclamation, "Destination File Exists" End If End Sub Move a file if it exists
CODESub MoveFile() Dim fso Dim file As String, sfol As String, dfol As String file = "test.xls" ' change to match the file name sfol = "C:\" ' change to match the source folder path dfol = "E:\" ' change to match the destination folder path Set fso = CreateObject("Scripting.FileSystemObject") If Not fso.FileExists(sfol & file) Then MsgBox sfol & file & " does not exist!", vbExclamation, "Source File Missing" ElseIf Not fso.FileExists(dfol & file) Then fso.MoveFile (sfol & file), dfol Else MsgBox dfol & file & " already exists!", vbExclamation, "Destination File Exists" End If End Sub Delete a file if it exists
CODESub DeleteFile() Dim fso Dim file As String file = "C:\test.xls" ' change to match the file w/Path Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(file) Then fso.DeleteFile file, True Else MsgBox file & " does not exist or has already been deleted!" _ , vbExclamation, "File not Found" End If End Sub
Here are the Folder Procedures
Check if a folder exists
CODESub FolderExists() Dim fso Dim folder As String folder = "C:\My Documents" ' change to match the folder path Set fso = CreateObject("Scripting.FileSystemObject") If fso.FolderExists(folder) Then MsgBox folder & " is a valid folder/path.", vbInformation, "Path Exists" Else MsgBox folder & " is not a valid folder/path.", vbInformation, "Invalid Path" End If End Sub Create a folder if it doesn't exist
CODESub CreateFolder() Dim fso Dim fol As String fol = "c:\MyFolder" ' change to match the folder path Set fso = CreateObject("Scripting.FileSystemObject") If Not fso.FolderExists(fol) Then fso.CreateFolder (fol) Else MsgBox fol & " already exists!", vbExclamation, "Folder Exists" End If End Sub Copy a folder if it exists
CODESub CopyFolder() Dim fso Dim sfol As String, dfol As String sfol = "c:\MyFolder" ' change to match the source folder path dfol = "e:\MyFolder" ' change to match the destination folder path Set fso = CreateObject("Scripting.FileSystemObject") If Not fso.FolderExists(dfol) Then fso.CopyFolder sfol, dfol Else MsgBox dfol & " already exists!", vbExclamation, "Folder Exists" End If End Sub Move a folder if it exists
CODESub MoveFolder() ' *********************************************************** ' *** This will only work if your operating system *** ' *** allows it otherwise an error occurs *** ' *********************************************************** Dim fso Dim fol As String, dest As String sfol = "c:\MyFolder" ' change to match the source folder path dfol = "e:\MyFolder" ' change to match the destination folder path Set fso = CreateObject("Scripting.FileSystemObject") If Not fso.FolderExists(dfol) Then fso.MoveFolder sfol, dfol Else MsgBox dfol & " already exists!", vbExclamation, "Folder Exists" End If End Sub Delete a folder if it exists
CODESub DeleteFolder() ' *********************************************************** ' *** This will delete a folder even if it contains files *** ' *** Use With Caution *** ' *********************************************************** Dim fso Dim fol As String fol = "c:\MyFolder" ' change to match the folder path Set fso = CreateObject("Scripting.FileSystemObject") If fso.FolderExists(fol) Then fso.DeleteFolder fol Else MsgBox fol & " does not exist or has already been deleted!" _ , vbExclamation, "Folder not Found" End If End Sub A couple more procedures that might come in handy! 
Move ALL files (or of a specific file type) from one folder into another folder
CODESub MoveFilesFolder2Folder() Dim fso Dim sfol As String, dfol As String sfol = "c:\MyFolder" ' change to match the source folder path dfol = "e:\MyFolder" ' change to match the destination folder path Set fso = CreateObject("Scripting.FileSystemObject") On Error Resume Next If Not fso.FolderExists(sfol) Then MsgBox sfol & " is not a valid folder/path.", vbInformation, "Invalid Source" ElseIf Not fso.FolderExists(dfol) Then MsgBox dfol & " is not a valid folder/path.", vbInformation, "Invalid Destination" Else fso.MoveFile (sfol & "\*.*"), dfol ' Change "\*.*" to "\*.xls" to move Excel Files only End If If Err.Number = 53 Then MsgBox "File not found" End Sub Copy ALL files (or of a specific file type) in one folder into another folder
CODESub CopyFilesFolder2Folder() Dim fso Dim sfol As String, dfol As String sfol = "c:\MyFolder" ' change to match the source folder path dfol = "e:\MyFolder" ' change to match the destination folder path Set fso = CreateObject("Scripting.FileSystemObject") On Error Resume Next If Not fso.FolderExists(sfol) Then MsgBox sfol & " is not a valid folder/path.", vbInformation, "Invalid Source" ElseIf Not fso.FolderExists(dfol) Then MsgBox dfol & " is not a valid folder/path.", vbInformation, "Invalid Destination" Else fso.CopyFile (sfol & "\*.*"), dfol ' Change "\*.*" to "\*.xls" to move Excel Files only End If If Err.Number = 53 Then MsgBox "File not found" End Sub
I hope that you have found this informative and helpful! 
|
Back to VBA Visual Basic for Applications (Microsoft) FAQ Index
Back to VBA Visual Basic for Applications (Microsoft) Forum |
|
|
|