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 Sub DeleteAFile()
' *******************************************************************************************
' * Call A Function To Delete A File *
' *******************************************************************************************
If DeleteFile("O:\DatabaseExports\TestDelete.txt") Then
MsgBox ("File Was Deleted")
Else
MsgBox ("No File To Delete")
End If
End Sub
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
' * There are a few Caveats On This Function:
' * The folder "C:\" Will Test True
' * The folder "C:" Will Test False
' * Any other folder path must NOT end in a Backslash or it will test False
' * "C:\Temporary" will test True
' * "C:\Temporary\" will test False
' * A "Null" Folder Will Test False, but the Length Will Be One... Not Zero
' *******************************************************************************************
On Error GoTo err_In_Locate
' ***********************************************************
' * See If A Folder Exists *
' ***********************************************************
FolderExists = (Len(Dir(FolderPath, vbDirectory)) > 1)
mod_ExitFunction:
Exit Function
' ***************************************************
' * Error Correction Routines *
' ***************************************************
err_In_Locate:
FolderExists = False
Resume mod_ExitFunction
End Function
Public Sub TestFileExists()
' *******************************************************************************************
' * Call A Function To Test If A File Exists - See Example Below
' *******************************************************************************************
If FileExists("O:\DatabaseExports\TestDelete.txt") Then
MsgBox ("File Found")
Else
MsgBox ("File Not Found")
End If
End Sub
Public Function FileExists(FilePath As String) As Boolean
' *******************************************************************************************
' * THIS FUNCTION WILL TEST IF A FILE EXISTS AND RETURN TRUE OR FALSE *
' * Caution: The file extension MUST be present *
' *******************************************************************************************
If Len(Dir(FilePath)) > 0 Then
FileExists = True
Else
FileExists = False
End If
End Function
' *********************************************************************************************
' * Use The Line Input Command To Read Text File *
' *********************************************************************************************
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
' *********************************************************************************************
' * Use The DIR Command To Loop Through Files In A Directory and Read and Write Data *
' *********************************************************************************************
Private Function AddHeaderToPickAndRoute(InputFile As String, OutputFile As String, DataHeader As String)
' ***************************************************
' This Function Reads a Sequential File and
' Copies it to an Output file after adding
' a header line at the top of the file.
' When finished, it deletes the input file.
' ***************************************************
' ***************************************************
' Input and Output File Handles
' ***************************************************
Dim intFileInput As Integer
Dim intFileOutput As Integer
' ***************************************************
' Input and Output Buffers
' ***************************************************
Dim strIn As String
Dim strOut As String
' ***************************************************
' Open Input File
' ***************************************************
intFileInput = FreeFile()
Open InputFile For Input As #intFileInput
' ***************************************************
' Open Output File
' ***************************************************
intFileOutput = FreeFile()
Open OutputFile For Output As #intFileOutput
Print #intFileOutput, DataHeader
Do While Not EOF(intFileInput)
Line Input #intFileInput, strIn
Print #intFileOutput, strIn
Loop
Close #intFileInput
Close #intFileOutput
Kill (InputFile)
End Function