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
|
|
|
|
Talk To Other Members