Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
I = I + 1 'Increment loop counter
strKeyword intIndent strEndKeyword chrBlockMarker
(string*21) (integer) (string*21) (string*1)
Case 2 Case c
Do 2 Loop l
DoCmd 0
DoEvents 0
Else 2 Else e
For 2 Next f
Function 2 End Function F
If 2 End If i
Private Function 2 End Function F
Private Sub 2 End Sub S
Private Type 2 End Type t
Public Function 2 End Function F
Public Sub 2 End Sub S
Public Type 2 End Type t
Select Case 4 End Select s
Sub 2 End Sub S
Type 2 End Type t
While 2 Wend h
With 2 End With w
Option Compare Database
Option Explicit
Private Const ysnUseLettersToIndicateBlocks As Boolean = True
Function ysnDocumentModule(ByVal txtInputFileName As String, ByVal txtOutputFileName As String) As Boolean
' print ysnDocumentModule("C:\Temp\InputFile.txt","C:\Temp\OutputFile.txt")
Dim intInFileNo As Integer
Dim intOutFileNo As Integer
Dim strReadLine As String
Dim intIndent As Integer
Dim rstKeywords As Recordset
Dim strDataLine As String
Dim ysnNoEndMatch As Boolean
Dim ysnNoMatch As Boolean
Dim intSelectedIndent As Integer
Dim intLongestKeyword As Integer
Dim strIndent As String * 60
ysnDocumentModule = True
DoCmd.Hourglass True
strIndent = Space$(60)
intInFileNo = FreeFile
Open txtInputFileName For Input As intInFileNo
intOutFileNo = FreeFile
Open txtOutputFileName For Output As intOutFileNo
Set rstKeywords = CurrentDb.OpenRecordset("tblKeywords", dbOpenSnapshot, dbReadOnly)
If rstKeywords.EOF Then Exit Function
intIndent = 0
Do While Not EOF(intInFileNo)
Line Input #intInFileNo, strReadLine
strReadLine = Trim$(strReadLine)
strDataLine = strStripComment(strReadLine)
strDataLine = strReplaceBadChars(Trim$(strDataLine))
If strDataLine = "" Then
Print #intOutFileNo, Left$(strIndent, intIndent) & strReadLine
Else
If Right$(strDataLine, 1) = ":" Then 'Label
If intIndent > 2 Then
intIndent = intIndent - 2
Else
intIndent = 0
End If
Print #intOutFileNo, strReadLine
intIndent = intIndent + 2
ElseIf strDataLine Like "If *" And strDataLine Like "* Then *" Then
Print #intOutFileNo, Left$(strIndent, intIndent) & strReadLine
Else
intLongestKeyword = 0
intSelectedIndent = 0
rstKeywords.FindFirst "strEndKeyword = left$('" & strDataLine & "', Len(strEndKeyword))"
ysnNoEndMatch = rstKeywords.NoMatch
Do
If Len(rstKeywords!strEndKeyword) > intLongestKeyword Then
intLongestKeyword = Len(rstKeywords!strEndKeyword)
intSelectedIndent = rstKeywords!intIndent
End If
rstKeywords.FindNext "strEndKeyword = left$('" & strDataLine & "', Len(strEndKeyword))"
Loop Until rstKeywords.NoMatch
If Not ysnNoEndMatch Then
intIndent = intIndent - intSelectedIndent
End If
Print #intOutFileNo, Left$(strIndent, intIndent) & strReadLine
intLongestKeyword = 0
intSelectedIndent = 0
rstKeywords.FindFirst "strKeyword = left$('" & strDataLine & "', Len(strKeyword))"
ysnNoMatch = rstKeywords.NoMatch
Do
If Len(rstKeywords!strKeyword) > intLongestKeyword Then
intLongestKeyword = Len(rstKeywords!strKeyword)
intSelectedIndent = rstKeywords!intIndent
If ysnUseLettersToIndicateBlocks Then
Mid$(strIndent, intIndent + 1, 1) = rstKeywords!chrBlockMarker
Else
Mid$(strIndent, intIndent + 1, 1) = "¦"
End If
End If
rstKeywords.FindNext "strKeyword = left$('" & strDataLine & "', Len(strKeyword))"
Loop Until rstKeywords.NoMatch
If Not ysnNoMatch Then intIndent = intIndent + intSelectedIndent
End If
End If
Loop
lblExit:
Close #intInFileNo
Close #intOutFileNo
DoCmd.Hourglass False
Exit Function
lblErr:
MsgBox Err.Description, vbExclamation, "Documenter"
Resume lblExit
End Function
Function strStripComment(ByVal strLine As String) As String
Dim intPtr As Integer
Dim ysnInString As Boolean
ysnInString = False
intPtr = 1
Do While intPtr <= Len(strLine)
Select Case Mid$(strLine, intPtr, 1)
Case """"
ysnInString = Not ysnInString
Case "'"
If Not ysnInString Then Exit Do
End Select
intPtr = intPtr + 1
Loop
strStripComment = Left$(strLine, intPtr - 1)
End Function
Function strReplaceBadChars(ByVal strLine As String) As String
Dim intPtr As Integer
For intPtr = 1 To Len(strLine)
If Mid$(strLine, intPtr, 1) = "'" Then Mid$(strLine, intPtr, 1) = "q"
If Mid$(strLine, intPtr, 1) = """" Then Mid$(strLine, intPtr, 1) = "Q"
If Mid$(strLine, intPtr, 1) = "|" Then Mid$(strLine, intPtr, 1) = "¦"
Next intPtr
strReplaceBadChars = strLine
End Function
print ysnDocumentModule("C:\Temp\InputFile.txt","C:\Temp\OutputFile.txt")