We're using JSDoc3 as a preformatter for MSWord documentation. This macro runs JSDoc3 on the specified files, combines them into a Word document and does some preliminary formatting. It requires two tables. The first is the AltText Title "Scripts" and contains a list of the script names to include:
Scripts |
DLI_ApplicationMap.sj |
DLI_ResolveName.sj |
and so on ... |
The second table contains paths, has the Alt Text Title "Parameters," and looks like this:
Parameters |
|
sSrcPath1 |
c:\QualityAssurance\ASMT\script |
sSrcPath2 |
c:\QualityAssurance\Shared\script |
sDstPath |
c:\jsdocs\src |
sHTMLPath |
c:\jsdocs\jsdoc-master\out |
Option Explicit
'=====================================================================================================
'= CombineModules This macro extracts JScript files from the QualityAssurance folder,
'= renames them to a jsdoc3 friendly name, executes jsdoc, and then
'= combines the files into a word document.
'=====================================================================================================
Sub CombineModules()
Dim sSrcPath(1) As String
Dim sDstPath As String
Dim sHTMLPath As String
Dim fso As New Scripting.FileSystemObject
Dim dParms As New Scripting.Dictionary
Dim oFolder, oFile
Dim sSrcFile As String
Dim sDstFile As String
Dim sHTMLFile As String
Dim oResult
Dim bFound As Boolean
Dim i As Integer
Dim iFormatted As Integer: iFormatted = 1
Dim sMessage As String
Dim iSrc As Integer: isrc=0
sMessage = "Formatting documents ..."
Application.StatusBar = sMessage
'Set the source and destination directories and cleanup files from previous runs
Set dParms = LoadParameters()
If dParms.Count = 0 Then: MsgBox ("No parameters found, exiting..."): Exit Sub
sSrcPath(0) = dParms("sSrcPath1")
sSrcPath(1) = dParms("sSrcPath2")
sDstPath = dParms("sDstPath")
sHTMLPath = dParms("sHTMLPath")
fso.DeleteFolder sDstPath, True
fso.CreateFolder sDstPath
fso.DeleteFolder sHTMLPath, True
fso.CreateFolder sHTMLPath
'load the array of valid scripts for this documentation
Dim sScripts() As String 'create a dynamic array of scripts
ReDim sScripts(0 To 25)
LoadValidScripts sScripts
If UBound(sScripts) < 0 Then: MsgBox ("No scripts found, exiting..."): Exit Sub
'copy test complete scripts and rename with a ".js" extension files, then call jsdoc to create html
For isrc=0 To 1 Step 1
Set oFolder = fso.GetFolder(sSrcPath(iSrc))
For Each oFile In oFolder.Files
sSrcFile = oFile.Path
sDstFile = Replace(sSrcFile, sSrcPath(iSrc), sDstPath, , , vbTextCompare)
sDstFile = Replace(sDstFile, ".sj", ".js")
bFound = False
For i = 0 To UBound(sScripts, 1)
If (oFile.Name = sScripts(i)) Then 'the item was found
bFound = True
Exit For
End If
Next i
If bFound Then
fso.CopyFile sSrcFile, sDstFile, True
Dim wsh As Object
Set wsh = VBA.CreateObject("WScript.Shell")
Dim errorCode As Integer
Call wsh.Run("C:\jsdocs\jsdoc-master\jsdoc.cmd " & sDstFile, vbMinimizedNoFocus, True)
Application.StatusBar = "Formatting file " & iFormatted & " of " & UBound(sScripts, 1)
iFormatted = iFormatted + 1
End If
Next oFile
Next iSrc
Application.StatusBar = "Combining files ..."
Selection.GoTo wdGoToBookmark, , , "\EndOfDoc"
For i = 0 To UBound(sScripts, 1) Step 1
sHTMLFile = "c:\jsdocs\jsdoc-master\out\module-" & Replace(sScripts(i), ".sj", "") & ".html"
On Error Resume Next
Selection.InsertFile FileName:=sHTMLFile, Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False
If Err.Number = 0 Then
With Selection
Application.ScreenUpdating = False
.HomeKey Unit:=wdStory
.Find.ClearFormatting
.Find.Text = "Index"
If .Find.Execute Then
.Select
.EndKey Unit:=wdStory, Extend:=wdExtend
.Delete Unit:=wdCharacter, Count:=1
.TypeParagraph
.Style = ActiveDocument.Styles("Normal")
End If
End With
End If
Next i
Application.StatusBar = ""
End Sub
'=====================================================================================================
'= LoadValidScripts The the list of script names from the "Document these scripts" table.
'=====================================================================================================
Private Sub LoadValidScripts(ByRef sArr() As String)
Dim i As Integer 'Table row counter
Dim j As Integer 'Array row counter
Dim tTable As Table 'the scripts table
Dim sText 'text value of table row
For Each tTable In ThisDocument.Tables 'Find the correct table
If tTable.Title = "Scripts" Then
j = 0
For i = 0 To tTable.Rows.Count - 1 Step 1 'and load the rows into an array
If i > UBound(sArr, 1) Then ReDim Preserve sArr(UBound(sArr, 1) + 25)
sText = Trim(tTable.Cell(i, 0).Range.Text)
If (InStr(sText, ".sj") > 0) Then
sArr(j) = Left(sText, InStr(sText, ".sj") + 2)
j = j + 1
End If
Next i 'process rows
End If 'table found
Next tTable 'find the table
ReDim Preserve sArr(j - 1)
Call QuickSort(sArr, 0, j - 1)
End Sub
'=====================================================================================================
'= LoadParameters This function loads the parameters table into a dictionary object.
'=====================================================================================================
Private Function LoadParameters() As Scripting.Dictionary
Dim i As Integer 'Table row counter
Dim tTable As Table 'Table containing parameters
Dim sText As String 'parameter text
Dim sKey As String 'parameter key
Dim dParms As New Scripting.Dictionary 'associative array containing key/value pairs
For Each tTable In ThisDocument.Tables 'First, find the table
If tTable.Title = "Parameters" Then
For i = 0 To tTable.Rows.Count - 1 Step 1 'Now load the parameters
sKey = Mid(tTable.Cell(i, 1).Range.Text, 1, InStr(1, tTable.Cell(i, 1).Range.Text, Chr(13)) - 1)
If (Len(sKey) > 0 And Not dParms.Exists(sKey)) Then
sText = Mid(tTable.Cell(i, 2).Range.Text, 1, InStr(1, tTable.Cell(i, 2).Range.Text, Chr(13)) - 1)
dParms.Add sKey, sText
End If
Next i 'process rows
End If 'table found
Next tTable 'find the table
Set LoadParameters = dParms
End Function
'=====================================================================================================
' QuickSort, from MSDN, usage: QuickSort sArr, 0, j - 1
'=====================================================================================================
Sub QuickSort(arr, Lo As Long, Hi As Long)
Dim varPivot As Variant
Dim varTmp As Variant
Dim tmpLow As Long
Dim tmpHi As Long
tmpLow = Lo
tmpHi = Hi
varPivot = arr((Lo + Hi) \ 2)
Do While tmpLow <= tmpHi
Do While arr(tmpLow) < varPivot And tmpLow < Hi: tmpLow = tmpLow + 1: Loop
Do While varPivot < arr(tmpHi) And tmpHi > Lo: tmpHi = tmpHi - 1: Loop
If tmpLow <= tmpHi Then
varTmp = arr(tmpLow)
arr(tmpLow) = arr(tmpHi)
arr(tmpHi) = varTmp
tmpLow = tmpLow + 1
tmpHi = tmpHi - 1
End If
Loop
If Lo < tmpHi Then QuickSort arr, Lo, tmpHi
If tmpLow < Hi Then QuickSort arr, tmpLow, Hi
End Sub
'=====================================================================================================
'= TrimIndex This function trims the index portion of each HTML document.
'=====================================================================================================
Private Sub TrimIndex()
Selection.HomeKey
With Selection.Find
.Forward = True
.ClearFormatting
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.MatchPhrase = False
.Execute FindText:="Index"
End With
If Selection.FormattedText.Underline = wdUnderlineSingle Then
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
End If
End Sub
