Manipulate Files Via VBA Commands Without Windows Scripting Host
This code was provided courtesy of Douglas J. Steele, Microsoft Access MVP. (Douglas J Steele)
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. Using VBA commands directly instead of Windows Scripting Host will increase the speed of the action.
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
Option Compare Database
Option Explicit
Public Function CopyFile(SourceFile As String, _
TargetFile As String) As Boolean
' *********************************************************************************************
' * COPY A SOURCE FILE TO A TARGET FILE (OVERLAY TARGET IF PRESENT) *
' *********************************************************************************************
' *****************************************************************
' * (1) This function will copy a file from the SourceFile *
' * to the TargetFile - It will delete the TargetFile *
' * if it already exists *
' * (2) You can rename the file as you copy it *
' * (3) A full path to both source and target is recommended *
' * (4) If you omit the target path, the SourceFile is copied *
' * to The CurDir (Access Current Directory) *
' * (5) If you omit the source path, Access looks in the CurDir *
' * for the SourceFile *
' *****************************************************************
On Error GoTo err_In_Copy
FileCopy SourceFile, TargetFile
CopyFile = True
mod_ExitFunction:
Exit Function
' ***************************************************
' * Error Correction Routines *
' ***************************************************
err_In_Copy:
CopyFile = False
Resume mod_ExitFunction
End Function
Public Function DeleteFile(SourceFile As String) As Boolean
' *******************************************************************************************
' * DELETE A FILE *
' *******************************************************************************************
' *******************************************************************
' * (1) This function will delete a file *
' * (2) A full path to the file being deleted is recommended *
' * (3) If you omit the path, Access looks in the CurDir for the *
' * file to be deleted *
' *******************************************************************
On Error GoTo err_In_Delete
Kill SourceFile
DeleteFile = True
mod_ExitFunction:
Exit Function
' ***************************************************
' * File To Be Deleted Does Not Exist *
' ***************************************************
err_In_Delete:
DeleteFile = False
Resume mod_ExitFunction
End Function
Public Function RenameFile(SourceFile As String, NewName As String) As Boolean
' *******************************************************************************************
' RENAME A FILE *
' *******************************************************************************************
' *****************************************************************
' * (1) This function will rename a file from the SourceFile Name *
' * to the NewName if the NewName Doesn't Already Exist in *
' * the Target Path (the path associated with the NewName) *
' * (2) A full path to both source and target is recommended to *
' * avoid unexpected results *
' * (3) If you rename a file to a different path Access copies *
' * the file to the new path with whatever name you give it *
' * and then deletes the source file from the original path *
' * (4) If you omit the target path, the SourceFile is copied *
' * to The CurDir (Access Current Directory) with the NewName *
' * as long as the NewName doesn't exist in the CurDir
' * (5) If you omit the source path, Access looks in the CurDir *
' * for the SourceFile *
' *****************************************************************
On Error GoTo err_In_Rename
Name SourceFile As NewName
RenameFile = True
mod_ExitFunction:
Exit Function
' ***************************************************
' * File To Be Renamed Doesn't Exist *
' ***************************************************
err_In_Rename:
RenameFile = False
Resume mod_ExitFunction
End Function
Public Function FolderExists(FolderPath As String) As Boolean
' *******************************************************************************************
' * THIS FUNCTION WILL TEST IF A FOLDER EXISTS *
' *******************************************************************************************
On Error GoTo err_In_Locate
' ***********************************************************
' * See If A Folder Exists *
' ***********************************************************
FolderExists = (Len(Dir(FolderPath, vbDirectory)) > 0)
mod_ExitFunction:
Exit Function
' ***************************************************
' * Error Correction Routines *
' ***************************************************
err_In_Locate:
FolderExists = False
Resume mod_ExitFunction
End Function
Public Function FileExists(FilePath As String) As Boolean
' *******************************************************************************************
' * THIS FUNCTION WILL TEST IF A FILE EXISTS *
' *******************************************************************************************
On Error GoTo err_In_Locate
' ***********************************************************
' * See If A File Exists - Provide The Full Path to the File
' ***********************************************************
FileExists = (Len(Dir(FilePath)) > 0)
mod_ExitFunction:
Exit Function
' ***************************************************
' * Error Correction Routines *
' ***************************************************
err_In_Locate:
FileExists = False
Resume mod_ExitFunction
End Function
Public Function ReadATextFileToEOF()
' ***************************************************
' * Open a Text File And Loop Through It *
' ***************************************************
Dim intFile As Integer
Dim strFile As String
Dim strIn As String
Dim strOut As String
Dim booFound As Boolean
booFound = False
strOut = vbNullString
intFile = FreeFile()
strFile = "C:\Folder\MyData.txt"
Open strFile For Input As #intFile
Do While Not EOF(intFile)
Line Input #intFile, strIn
If Left(strIn, 7) = "KeyWord" Then
strOut = Mid(strIn, 8)
booFound = True
Exit Do
End If
Loop
Close #intFile
If booFound Then
MsgBox "Your Data is " & strOut
Else
MsgBox "Keyword Not Found"
End If
End Function