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 Rhinorhino 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
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]](/data/assets/smilies/thumbsup2.gif "[thumbsup2] [thumbsup2]")
[color blue]Let's start with the File Procedures[/color]
Check if a file exists
Copy a file if it exists
Move a file if it exists
Delete a file if it exists
[color blue]Here are the Folder Procedures[/color]
Check if a folder exists
Create a folder if it doesn't exist
Copy a folder if it exists
Move a folder if it exists
Delete a folder if it exists
[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
Copy ALL files (or of a specific file type) in one folder into another folder
I hope that you have found this informative and helpful!
I know it's long, but it's worth it!
[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 SubCopy 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 SubMove 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 SubDelete 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 SubCreate 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 SubCopy 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 SubMove 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 SubDelete 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 SubCopy 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 SubI hope that you have found this informative and helpful!