Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

File and Folder Procedures

VBA How To

File and Folder Procedures

by  Bowers74  Posted    (Edited  )
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! [thumbsup2]

[color blue]Let's start with the File Procedures[/color]


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


[color blue]Here are the Folder Procedures[/color]


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()
[color red]' ***********************************************************
' ***      This will only work if your operating system   ***
' ***          allows it otherwise an error occurs        ***
' ***********************************************************[/color]
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()
[color red]' ***********************************************************
' *** This will delete a folder even if it contains files ***
' ***                 Use With Caution                    ***
' ***********************************************************[/color]
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

[color green]A couple more procedures that might come in handy![/color] ;-)

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! [thumbsup2]

Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top