Manipulate Files Via Windows Scripting Host Within Access
There are quite a number of applications that need to use, copy, delete, rename or test for existence of regular files, such as text file, images, and so forth. Access allows the implementation of Windows Scripting Host commands from within the code, making the process fairly simple.
Using Scripting Host is slower than direct VBA commands, but the code is presented here for reference. See the "Manipulate Files via VBA" page for the faster examples.
The code examples below can be inserted into your project. Each of these functions returns a true or false to indicate if the operation was successful.
A sample of calling these routines would be as follows:
If Not CopyFile("C:\TestDirectory\MyFile1.jpg", "C:\NewTestDirectory\MyNewName.jpg") Then
Msgbox("File Copy Did Not Succeed")
End If
Here are examples of several routines that allow file manipulation:
Program Code
' *******************************************************************************************
' * COPY A SOURCE FILE TO A TARGET FILE (OVERLAY TARGET IF PRESENT) *
' *********************************************************************************************
Option Compare Database
Option Explicit
Option Base 1
Public Function CopyFile(SourceFile As String, _
TargetFile As String) As Boolean
' *********************************************************
' * This function will copy a file from the SourceFile *
' * To the TargetFile - It will delete the TargetFile *
' * If it already exists *
' * A Full Path to Both Is Required *
' *********************************************************
Dim fs
On Error GoTo err_In_Copy
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile SourceFile, TargetFile, True
CopyFile = True
Set fs = Nothing
mod_ExitFunction:
Exit Function
' ***************************************************
' * Error Correction Routines *
' ***************************************************
err_In_Copy:
CopyFile = False
Set fs = Nothing
Resume mod_ExitFunction
End Function
' *******************************************************************************************
' * DELETE A FILE *
' *******************************************************************************************
Option Compare Database
Option Explicit
Option Base 1
Public Function DeleteFile(SourceFile As String) As Boolean
' *********************************************************
' * This function will delete a file *
' * A full path to the file being deleted is required *
' *********************************************************
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
On Error GoTo err_In_Delete
fs.DeleteFile SourceFile
DeleteFile = True
mod_ExitFunction:
Set fs = Nothing
Exit Function
' ***************************************************
' * File To Be Deleted Does Not Exist *
' ***************************************************
err_In_Delete:
DeleteFile = False
Resume mod_ExitFunction
End Function
' *******************************************************************************************
' RENAME A FILE *
' *******************************************************************************************
Option Compare Database
Option Explicit
Option Base 1
Public Function RenameFile(SourceFile As String, NewName As String) As Boolean
' *********************************************************
' * This function will rename a file
' * The Source File contains the full path
' * The NewName is the name only without the path
' *********************************************************
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
' ***************************************************
' * Rename The File If Present *
' ***************************************************
On Error GoTo err_In_Rename
Set f = fs.GetFile(SourceFile)
f.Name = NewName
RenameFile = True
mod_ExitFunction:
Set fs = Nothing
Set f = Nothing
Exit Function
' ***************************************************
' * File To Be Renamed Doesn't Exist *
' ***************************************************
err_In_Rename:
RenameFile = False
Resume mod_ExitFunction
End Function
' *******************************************************************************************
' * THIS FUNCTION WILL TEST IF A FOLDER EXISTS *
' *******************************************************************************************
Option Compare Database
Option Explicit
Option Base 1
Public Function FolderExists(FolderPath As String) As Boolean
Dim fs
On Error GoTo err_In_Locate
Set fs = CreateObject("Scripting.FileSystemObject")
' ***********************************************************
' * See If A Folder Exists *
' ***********************************************************
If fs.FolderExists(FolderPath) Then
FolderExists = True
Else
FolderExists = False
End If
Set fs = Nothing
mod_ExitFunction:
Exit Function
' ***************************************************
' * Error Correction Routines *
' ***************************************************
err_In_Locate:
FolderExists = False
Set fs = Nothing
Resume mod_ExitFunction
End Function
' *******************************************************************************************
' * THIS FUNCTION WILL TEST IF A FILE EXISTS *
' *******************************************************************************************
Option Compare Database
Option Explicit
Option Base 1
Public Function FileExists(FilePath As String) As Boolean
Dim fs
On Error GoTo err_In_Locate
Set fs = CreateObject("Scripting.FileSystemObject")
' ***********************************************************
' * See If A File Exists *
' ***********************************************************
If fs.FileExists(FilePath) Then
FileExists = True
Else
FileExists = False
End If
Set fs = Nothing
mod_ExitFunction:
Exit Function
' ***************************************************
' * Error Correction Routines *
' ***************************************************
err_In_Locate:
FileExists = False
Set fs = Nothing
Resume mod_ExitFunction
End Function
' *******************************************************************************************
' * THIS FUNCTION WILL READ SEQUENTIALLY THROUGH A TEXT FILE *
' *******************************************************************************************
Option Compare Database
Option Explicit
Public Function ReadTextFile()
Dim objFSO As Object
Dim objTextStream As Object
Dim strTextLine As String
Dim strInputFileName As String
On Error GoTo FileNotFound
strInputFileName = "C:\MyTestFile.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextStream = objFSO.OpenTextFile(strInputFileName)
Do While Not (objTextStream.AtEndOfStream)
strTextLine = objTextStream.ReadLine
MsgBox ("My Input String is " & strTextLine)
If Left(strTextLine, 5) = "ABCDE" Then
MsgBox ("Found ABCDE")
End If
Loop
objTextStream.Close
ClearObjects:
Set objFSO = Nothing
Set objTextStream = Nothing
On Error GoTo 0
Exit Function
FileNotFound:
MsgBox ("File Not Found")
Resume ClearObjects
End Function