Regular Expression and Output Text File

[robert_neville]

I have immersed myself with a regular expression module, yet remain new to VBA programs. These modules should help me add field headers and correct inconsistencies in my free form data source. My concentration relate to effectively open a file, replace a bunch of text with multiple regular expression patterns; save as a new file with an addendum to the filename; and create a User Interface for code execution. The process will embody multiple steps for quality assurance and evaluating new regular expressions.

My first draft is not elegant and draws from your examples. This area remains new territory, so be gentle with your critique. My confusion stems from the difficulty in navigating Microsoft help file system. Plus, several approaches exist (Input, Print, Write, Get, Put, Textstream, fso.CreateTextFile, etc.). Plus, regular expressions with double quote present a challenge when passing the pattern to the function. I spent eighteen hours mulling over the help files and newsgroup posts. Their examples are rudimentary.

Private Sub cmdStep1_Click()
' Purpose: Add ProjName Field Delimiters within the Import Data

Const cstrProc As String = "cmdLoad_Click"

On Error GoTo cmdLoad_Click_Err

Dim intRet As Integer

If IsNull(Me!txtFile) Then
Beep
MsgBox "File name required."
Exit Sub
End If
If Len(Dir(Me!txtFile)) = 0 Then
Beep
MsgBox Me!txtFile & " file not found."
Exit Sub
End If
DoCmd.Hourglass True

' Function FindAndReplace(varFind As Variant, _
Pattern As String, _
strReplace As String, _
Optional blnCaseSensitive As Boolean = False, _
Optional blnGlobal As Boolean = True, _
Optional FailOnError As Boolean = True) As String

strFileContents = FileContents(Me!txtFile)
strFileContents = FindAndReplace(FileContents, "^\'\w+\'$", "ProjName:»$&", True, True, True)
' The logic should allow for multiple Find And Replace statements
' since it should add delimiters and correct certain anomalies like
' word abbreviations (like St. or Fedex=Federal Express). Then output to a text file with a file name suffix.

strFileContents = OutputTextFile(Me!txtFile)
strFileContents = Dir(Me!txtFile2.ControlSource)


DoCmd.Hourglass False

cmdLoad_Click_Exit:
Exit Sub

cmdLoad_Click_Err:
Call ErrMsgStd(Me.Name & "." & cstrProc, Err.Number, Err.Description, True)
Resume cmdLoad_Click_Exit

End Sub

Public Function FileContents(varFileSpec As Variant, _
Optional blnReturnErrors As Boolean = False, _
Optional ByRef lngErrCode As Long) As Variant
' Retrieves contents of file as a string
' Silently returns Null on error unless
' ReturnErrors is true, in which case
' uses CVErr() to return an error value.
' Optionally, you can retrieve the error
' code in the ErrCode argument

Dim lngNum As Long

On Error GoTo Err_FileContents

If IsNull(FileSpec) Then
FileContents = Null
Else
lngNum = FreeFile()
Open varFileSpec For Input As #lngNum
FileContents = Input(LOF(lngNum), #lngNum)
End If
ErrCode = 0
GoTo Exit_FileContents

Err_FileContents:
ErrCode = Err.Number
If blnReturnErrors Then
FileContents = CVErr(Err.Number)
Else
FileContents = Null
End If
Err.Clear

Exit_FileContents:
Close #lngNum

End Function

Public Function OutputTextFile(varOutFile As Variant, _
strFileName As String, _
strSuffix As String)

Dim lngNum As Long

If IsNull(varOutFile) Then
OutputTextFile = Null
Else
lngNum = FreeFile()
strNewFileName = Left(varFileName, (Len(varFileName) - 4)) & strSuffix & ".txt"
Open varOutFile For Output As #lngNum
Print #lngNum, strNewFileName
Close #lngNum
End If


End Function

Function FindAndReplace(varFind As Variant, _
Pattern As String, _
strReplace As String, _
Optional blnCaseSensitive As Boolean = False, _
Optional blnGlobal As Boolean = True, _
Optional FailOnError As Boolean = True) As String

'VBScript.Regexp error messages
Dim objReg As Object
Dim strFind As String

If IsNull(varOriginal) Then Exit Function

Set objReg = CreateObject("VBScript_RegExp_55.RegExp")

objReg.Global = blnGlobal
objReg.IgnoreCase = blnCaseSensitive
objReg.Pattern = Pattern
strFind = CStr(varFind)

'Do the job
FindAndReplace = objReg.Replace(strFind, strReplace)

Set objReg = Nothing

Exit Function

End Function