×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

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

CODE

Sub 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

CODE

Sub 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

CODE

Sub 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

CODE

Sub 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

CODE

Sub 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

CODE

Sub 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

CODE

Sub 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

CODE

Sub 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

CODE

Sub 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

CODE

Sub 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

CODE

Sub 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

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close