最新消息:20210816 当前crifan.com域名已被污染,为防止失联,请关注(页面右下角的)公众号

[version:2010-01-14] extract menu command from word to xml file

VBA crifan 1933浏览 0评论

‘Attribute VB_Name = “extractMenuCmdToXml”
Public Const constOutputFileName As String = “2300_PAP_Settings.xml”
Public Const constLogFileName As String = “extract_commands_log.txt”

Public Const constXmlVer As String = “1.0”
Public Const constPrjName As String = “2300”

‘ this strings must equal with them in Word File
Public Const constStrTBD As String = “TBD”
Public Const constStrNotCare As String = “NOT_CARE”
Public Const constStrUnsupported As String = “UNSUPPORTED”

Public Const constTodoLine As String = vbTab & “<MenuCmd cmd=’TODO’ param=’TODO’> <note>uncompleted, when completed, remove this</note> </MenuCmd>”

‘———- Table: Function Name and Function Description ———-

‘Public Const constTotalFuncTblColCnt As Integer = 3  ‘total column number of valid Function table
Public Const constStrFuncName As String = “FunctionName”
Public Const constStrFuncDesc As String = “FunctionDescription”
Public Const constStrFuncCmd As String = “FunctionCommand”
Public Const constFuncNameColIdx As Integer = 1 ‘Function Name column number
Public Const constFuncDescColIdx As Integer = 2 ‘FunctionDescription column number
Public Const constFuncCmdColIdx As Integer = 3 ‘FunctionCommand column number

‘———- Table: Menu Command and Description ———-
Public Const constTotalTblColCnt As Integer = 5  ‘total column number of valid table
Public Const constStrMenuCmd As String = “Menu Command”
Public Const constStrDescription As String = “Description”
Public Const constMenuCmdColIdx As Integer = 4 ‘menu command column number
Public Const constDescColIdx As Integer = 5 ‘description column number

Public Const constMenuCmdTagLen As Integer = 6 ‘menu command len of main tag and sub tag is 3+3=6
Public Const constValidCmdMinLen As Integer = 7 ‘include “.”, the minimal length of valid command, such as 999962.

Public gCmd As String
Public gParam As String
Public gNote As String

Public gFuncName As String
Public gFuncDesc As String
Public gFuncCmd As String

‘ ———-output file realted———-
Public gFileNum As Integer
Public gDestFile As String
Public gOutputFileNameWithPath As String
‘  ———- log file related ———-
Public gLogFile As Object
Public gLogFullFileName As String

‘———-log report details———-
‘Enum e_ErrorType
‘    Error_Unknown
‘    Error_Table
‘    Error_Command
‘End Enum

Type t_ErrorItem
    ‘errType     As e_ErrorType
    ‘funcName    As String
    tblNr       As Integer ‘error in which table
    rowIdx      As Integer ‘error in which row of the “Menu Command” column
    errCmd      As String ‘error menu command content
    errDesc     As String ‘error description
End Type

Type t_ErrorInfo
    ‘errNrPerFunc    As Integer ‘ errors per funciton
    curErrItemIdx   As Integer  ‘record current error item index
    errArray(120)   As t_ErrorItem   ‘max 20 tables per func, every func max has 6 row, so max errors per func not exceed 120
End Type

Public gErrInFunc As t_ErrorInfo    ‘record error details per function

Type t_LogInfo
    totalTblNr   As Integer
   
    validNr As Integer
    invalidNr   As Integer
    ‘misc invalid type
    tbdNr   As Integer
    unsupportedNr As Integer
    blankNr As Integer
    notcareNr    As Integer
    includeQuestionMarkNr As Integer
    errorNr    As Integer
End Type

Public gLogInFunc As t_LogInfo
Public gLogSummary As t_LogInfo

‘———- others ———-
Type t_ProcessingInfo
    curTblIdxInFunc As Integer    ‘current table index in current function
    curRowIdxInTbl  As Integer  ‘row index of “menu command” in current table
End Type

Public gProcessingInfo As t_ProcessingInfo

Public gNeedOutputTodoLine As Boolean ‘ when include TBD/?/blank, should output TODO line

Public Const constCh2Heading As String = “Translating Procedure for Functions” ‘the heading of charpter 2

Function createOutputFile()
Dim openFileOK As Boolean

openFileOK = True

‘ 0. init file name
gOutputFileNameWithPath = ActiveDocument.Path & “” & constOutputFileName

‘ 1. create an XML file
gDestFile = gOutputFileNameWithPath

‘ Obtain next free file handle number.
gFileNum = FreeFile()

‘ Turn error checking off.
On Error Resume Next

‘ Attempt to open destination file for output.
Open gDestFile For Output As #gFileNum

‘ If an error occurs report it and end.
If Err <> 0 Then
    openFileOK = False
    MsgBox “Cannot create file: ” & gDestFile
End If

‘ Turn error checking on.
On Error GoTo 0

createOutputFile = openFileOK

End Function

Function printToOutputFile(strToPrint)
Print #gFileNum, strToPrint
End Function

Function closeOutputFile()
‘ Close destination file.
Close #gFileNum
End Function

Function createLogFile()

‘ open the file ouput TextStream output, overwritng is necessary
Dim fso As Object
Set fso = CreateObject(“Scripting.FileSystemObject”)

gLogFullFileName = ActiveDocument.Path & “” & constLogFileName
Set gLogFile = fso.CreateTextFile(gLogFullFileName, True)

End Function

Function outputLogInfo(info)
‘printToOutputFile (“LOG—>>>” & info)
gLogFile.WriteLine info
End Function

Function outputLogForEachFunc()
Dim i As Integer

‘ output log info for each function
outputLogInfo “Menu Commands Details:”
outputLogInfo “Valid=” & String(2, vbTab) & gLogInFunc.validNr
outputLogInfo “Invalid=” & vbTab & gLogInFunc.invalidNr
outputLogInfo vbTab & “Invalid Menu Commands Detail:”
outputLogInfo vbTab & “Blank=” & String(5, vbTab) & gLogInFunc.blankNr
outputLogInfo vbTab & “TBD=” & String(5, vbTab) & gLogInFunc.tbdNr
outputLogInfo vbTab & “Not_Care=” & String(4, vbTab) & gLogInFunc.notcareNr
outputLogInfo vbTab & “Unsupported=” & String(3, vbTab) & gLogInFunc.unsupportedNr
outputLogInfo vbTab & “IncludeQuestionMark=” & vbTab & gLogInFunc.includeQuestionMarkNr
outputLogInfo vbTab & “Errors=” & String(5, vbTab) & gLogInFunc.errorNr
If gLogInFunc.errorNr > 0 Then
    outputLogInfo String(2, vbTab) & “Error Menu Commands Detail:”
    outputLogInfo String(2, vbTab) & “ErrorIndex” & vbTab & “TableIndex” & vbTab & “RowIndex” & vbTab & “MenuCommand” & String(2, vbTab) & “Description”
   
    For i = 1 To gLogInFunc.errorNr ‘is the next error item to add err info, so need -1
        outputLogInfo String(2, vbTab) & i & String(3, vbTab) & gErrInFunc.errArray(i).tblNr & String(3, vbTab) & _
            gErrInFunc.errArray(i).rowIdx & String(3, vbTab) & _
            Replace(gErrInFunc.errArray(i).errCmd, vbCr, Space(1)) & String(3, vbTab) & _
            gErrInFunc.errArray(i).errDesc
    Next i

End If

End Function

Function outputLogSummary()
‘output summary log info
outputLogInfo vbCrLf
outputLogInfo String(60, “=”) ‘show many “=” as divison line
outputLogInfo “Summary info:”
outputLogInfo “Total Tables=” & vbTab & gLogSummary.totalTblNr
outputLogInfo “Menu Commands Details:”
outputLogInfo “Total Valid=” & vbTab & gLogSummary.validNr
outputLogInfo “Total Invalid=” & vbTab & gLogSummary.invalidNr
outputLogInfo vbTab & “Invalid Menu Commands Detail:”
outputLogInfo vbTab & “Blank=” & String(5, vbTab) & gLogSummary.blankNr
outputLogInfo vbTab & “TBD=” & String(5, vbTab) & gLogSummary.tbdNr
outputLogInfo vbTab & “Not_Care=” & String(4, vbTab) & gLogSummary.notcareNr
outputLogInfo vbTab & “Unsupported=” & String(3, vbTab) & gLogSummary.unsupportedNr
outputLogInfo vbTab & “IncludeQuestionMark=” & vbTab & gLogSummary.includeQuestionMarkNr
outputLogInfo vbTab & “Errors=” & String(5, vbTab) & gLogSummary.errorNr

End Function

Function closeLogFile()
gLogFile.Close
Set gLogFile = Nothing
End Function

Function handleSpecialCharacter(strToHandle As String)

‘1. repalce several abnormal characters
strToHandle = Replace(strToHandle, “‘”, Chr(39)) ‘left apostrophe  =‘=0xal 0xae -> 39=0x27=’
strToHandle = Replace(strToHandle, “’”, Chr(39)) ‘right apostrophe =’=0xal 0xaf -> 39=0x27=’
strToHandle = Replace(strToHandle, ““”, Chr(34)) ‘left quotation mark  =“=0xal 0xe3 -> 34=0x22=”
strToHandle = Replace(strToHandle, “””, Chr(34)) ‘right quotation mark =”=0xal 0xc0 -> 34=0x22=”
strToHandle = Replace(strToHandle, “–”, “-“) ‘ –=0xa8 0x43 -> 45=0x2D=-

‘ 2. handle special character in XML:
‘   &amp;      &   和号     ampersand
‘   &lt;       <   小于     less than
‘   &gt;       >   大于     greater than
‘   &apos;     ‘   单引号   apostrophe
‘   &quot;     ”   引号     quotation mark
‘ [Note]
‘ Only the characters “<” and “&” are strictly illegal in XML.
‘ The greater than character ‘>’ is legal, but it is a good habit to replace it.
‘ For safety, here replace all these special ones

‘must handle this first for other 3 include “&”
strToHandle = Replace(strToHandle, Chr(38), “&amp;”)
strToHandle = Replace(strToHandle, Chr(60), “&lt;”)
strToHandle = Replace(strToHandle, Chr(62), “&gt;”)
strToHandle = Replace(strToHandle, Chr(96), “&apos;”)
strToHandle = Replace(strToHandle, Chr(34), “&quot;”)

handleSpecialCharacter = strToHandle
End Function

Function checkTableValid(tblToChk As Table) As Boolean
‘ 1. the columns count must be 5:
‘ “Bit Position”    “Bit Value”   “Function”    “Menu Command”    “Description”
‘ 2. column 4 and 5 must be: “Menu Command”    “Description”
Dim valid As Boolean
Dim tmpStr As String

valid = True

If tblToChk.Columns.Count <> constTotalTblColCnt Then
    valid = False
    outputLogInfo “Table[” & gProcessingInfo.curTblIdxInFunc & “] Invalid for Column Count=” _
        & tblToChk.Columns.Count & ” !!!”
    GoTo AlreadyCheck
End If

‘tmpStr = Left(tblToChk.Columns(constMenuCmdColIdx).Cells(1), Len(constStrMenuCmd))
tmpStr = tblToChk.Columns(constMenuCmdColIdx).Cells(1).Range.Text
tmpStr = Mid(tmpStr, 1, InStr(tmpStr, vbCr) – 1)
If StrComp(tmpStr, constStrMenuCmd) <> 0 Then
    valid = False
    outputLogInfo “Table[” & gProcessingInfo.curTblIdxInFunc & “] Invalid for Menu Command column string:” _
        & tmpStr & “, should be:” & constStrMenuCmd & ” !!!”
    GoTo AlreadyCheck
End If

‘tmpStr = Left(tblToChk.Columns(constDescColIdx).Cells(1), Len(constStrDescription))
tmpStr = tblToChk.Columns(constDescColIdx).Cells(1).Range.Text
tmpStr = Mid(tmpStr, 1, InStr(tmpStr, vbCr) – 1)
If StrComp(tmpStr, constStrDescription) <> 0 Then
    valid = False
    outputLogInfo “Table[” & gProcessingInfo.curTblIdxInFunc & “] Invalid for Description column string:” _
        & tmpStr & “, should be:” & constStrDescription & ” !!!”
    GoTo AlreadyCheck
End If

AlreadyCheck:

‘ return value
checkTableValid = valid

End Function

Function checkFuncDescTableValid(tbl As Table) As Boolean
‘ the table must be:
‘ “FunctionName”    “FunctionDescription”
‘tmp not include: “FunctionCommand”
Dim valid As Boolean

valid = False

‘If tbl.Columns.Count = constTotalFuncTblColCnt Then
    If StrComp(Left(tbl.Columns(constFuncNameColIdx).Cells(1), Len(constStrFuncName)), constStrFuncName) = 0 Then ‘ is the defined FuncName
        If StrComp(Left(tbl.Columns(constFuncDescColIdx).Cells(1), Len(constStrFuncDesc)), constStrFuncDesc) = 0 Then ‘ is the defined FuncDesc
            ‘If StrComp(Left(tbl.Columns(constFuncCmdColIdx).Cells(1), Len(constStrFuncCmd)), constStrFuncCmd) = 0 Then ‘ is the defined FuncCmd
                If StrComp(tbl.Columns(constFuncNameColIdx).Cells(2), vbCr & Chr(7)) <> 0 Then ‘func name is not empty
                    valid = True
                End If
            ‘End If
        End If
    End If
‘End If

‘ return value
checkFuncDescTableValid = valid

End Function

Function checkCmdValid(cmd As String) As Boolean
‘ check whether the command is valid
‘ note: input cmd has beed removed the last two characters: CR,[BEL]
‘ here valid command like this:
‘ XXX       XXX     *           .
‘ MainTag   SubTag  parameter   end character
‘ in which:
‘ MainTag len = 3
‘ SubTag len = 3
‘ parameter len >= 1

Dim isValid As Boolean

Dim pointPosFromBegin, pointPosFromEnd As Integer

isValid = True

‘ 1. blank
If StrComp(cmd, vbNullString) = 0 Then
    gNeedOutputTodoLine = True ‘for later output the TODO line
    isValid = False
    gLogInFunc.blankNr = gLogInFunc.blankNr + 1
    GoTo AlreadyCheck
End If

‘ 2. include “?”
If InStr(cmd, “?”) > 0 Then
    gNeedOutputTodoLine = True ‘for later output the TODO line
    ‘ found ?, so invalid
    isValid = False
    gLogInFunc.includeQuestionMarkNr = gLogInFunc.includeQuestionMarkNr + 1
    GoTo AlreadyCheck
End If

‘ 3. TBD, should handle this first for step3:”other invalid command of short len” will omit this if do this step after step3
If StrComp(Left(cmd, Len(constStrTBD)), constStrTBD) = 0 Then
    gNeedOutputTodoLine = True ‘for later output the TODO line
    isValid = False
    gLogInFunc.tbdNr = gLogInFunc.tbdNr + 1
    GoTo AlreadyCheck
End If

‘ 4. NOT_CARE
If StrComp(Left(cmd, Len(constStrNotCare)), constStrNotCare) = 0 Then
    isValid = False
    gLogInFunc.notcareNr = gLogInFunc.notcareNr + 1
    GoTo AlreadyCheck
End If

‘ 5.Unsupported
If StrComp(Left(cmd, Len(constStrUnsupported)), constStrUnsupported) = 0 Then
    isValid = False
    gLogInFunc.unsupportedNr = gLogInFunc.unsupportedNr + 1
    GoTo AlreadyCheck
End If

‘ 6. valid command must contain “.”
pointPosFromBegin = InStr(cmd, “.”)
pointPosFromEnd = InStrRev(cmd, “.”)
If pointPosFromBegin <= 0 Then ‘ Not contain “.”
    isValid = False
    gLogInFunc.errorNr = gLogInFunc.errorNr + 1
   
    ‘record error detail
    gErrInFunc.errArray(gErrInFunc.curErrItemIdx).errCmd = cmd
    gErrInFunc.errArray(gErrInFunc.curErrItemIdx).errDesc = “Not contain “”.”” “
    gErrInFunc.errArray(gErrInFunc.curErrItemIdx).tblNr = gProcessingInfo.curTblIdxInFunc
    gErrInFunc.errArray(gErrInFunc.curErrItemIdx).rowIdx = gProcessingInfo.curRowIdxInTbl
    ‘update index
    gErrInFunc.curErrItemIdx = gErrInFunc.curErrItemIdx + 1
   
    GoTo AlreadyCheck
Else    ‘ Contain “.”
    If pointPosFromBegin <> pointPosFromEnd Then ‘ Contain at least two “.”
        isValid = False
        gLogInFunc.errorNr = gLogInFunc.errorNr + 1
       
        ‘record error detail
        gErrInFunc.errArray(gErrInFunc.curErrItemIdx).errCmd = cmd
        gErrInFunc.errArray(gErrInFunc.curErrItemIdx).errDesc = “Contain more than one “”.”” “
        gErrInFunc.errArray(gErrInFunc.curErrItemIdx).tblNr = gProcessingInfo.curTblIdxInFunc
        gErrInFunc.errArray(gErrInFunc.curErrItemIdx).rowIdx = gProcessingInfo.curRowIdxInTbl
        ‘update index
        gErrInFunc.curErrItemIdx = gErrInFunc.curErrItemIdx + 1
       
        GoTo AlreadyCheck
    End If
   
End If

‘ 7. other invalid command of short len
If Len(cmd) <= constValidCmdMinLen Then
    ‘ check wether is 99XXXX like command, this kind of command no parameter
    If (cmd Like “99####.”) = True Then
        isValid = True
        GoTo AlreadyCheck
    End If

    ‘ other misc invaid command of short length
    isValid = False
    gLogInFunc.errorNr = gLogInFunc.errorNr + 1
   
    ‘record error detail
    gErrInFunc.errArray(gErrInFunc.curErrItemIdx).errCmd = cmd
    gErrInFunc.errArray(gErrInFunc.curErrItemIdx).errDesc = “Command length short than the minimal=” & constValidCmdMinLen
    gErrInFunc.errArray(gErrInFunc.curErrItemIdx).tblNr = gProcessingInfo.curTblIdxInFunc
    gErrInFunc.errArray(gErrInFunc.curErrItemIdx).rowIdx = gProcessingInfo.curRowIdxInTbl
    ‘update index
    gErrInFunc.curErrItemIdx = gErrInFunc.curErrItemIdx + 1
   
    GoTo AlreadyCheck
End If

‘ all other left, are valid command

AlreadyCheck:

checkCmdValid = isValid

End Function

Function processCmd(strCmd As String)
‘ extract cmd and param
Dim paramLen As Integer
Dim pointPos As Integer

‘process command
gCmd = Left(strCmd, constMenuCmdTagLen)
gCmd = handleSpecialCharacter(gCmd)

‘process parameter
pointPos = InStr(strCmd, “.”)
paramLen = (pointPos – 1) – constMenuCmdTagLen ‘ “pointPos – 1’ to remove point

gParam = Mid(strCmd, constMenuCmdTagLen + 1, paramLen)
‘ handle some specials, tilll now include:
‘(1)DEFALT&
If (StrComp(gCmd, “DEFALT”) = 0) And (StrComp(gParam, “&”) = 0) Then
    gCmd = “DEFALT&”
    gCmd = handleSpecialCharacter(gCmd)
    gParam = “”
End If

gParam = handleSpecialCharacter(gParam)

End Function

Function processTable(tbl As Table)

Dim totalRowNrInMenuCmdCol
Dim startRowIdx As Integer
Dim strMenuCmd As String

totalRowNrInMenuCmdCol = tbl.Columns(constMenuCmdColIdx).Cells.Count
‘outputLogInfo “Row number in MenuCommand: ” & totalRowNrInMenuCmdCol
startRowIdx = 2 ‘exclude the first “Menu Command” cell

For gProcessingInfo.curRowIdxInTbl = startRowIdx To totalRowNrInMenuCmdCol
    strMenuCmd = tbl.Columns(constMenuCmdColIdx).Cells(gProcessingInfo.curRowIdxInTbl).Range.Text
    ‘do some pre-process
    strMenuCmd = Trim(strMenuCmd) ‘remove unnecessary space
    ‘remove the last CR=0x10,[BEL]=0x07
    ‘ note: the return value of InStrRev is the position, calulate from START, NOT from END, althogh it search from end to start !!!
    strMenuCmd = Left(strMenuCmd, (InStrRev(strMenuCmd, vbCr) – 1))
   
    ‘ only process it when valid
    If checkCmdValid(strMenuCmd) = True Then
        ‘ process valid command
        gLogInFunc.validNr = gLogInFunc.validNr + 1

        ‘ 1. process cmd and param
        Call processCmd(strMenuCmd)

        ‘ 2. process note
        Call processNote(tbl.Columns(constDescColIdx).Cells(gProcessingInfo.curRowIdxInTbl).Range.Text)

        ‘ 3. Write all info to output file
        Call printToOutputFile(groupToOneLine(gCmd, gParam, gNote))

    Else ‘invalid command
        gLogInFunc.invalidNr = gLogInFunc.invalidNr + 1
       
        GoTo NextCommand
    End If

NextCommand:
Next gProcessingInfo.curRowIdxInTbl

End Function

Function processFuncTable(funcTbl As Table, strHeading As String)
‘Dim strName, strDesc, strCmd

gFuncName = funcTbl.Columns(constFuncNameColIdx).Cells(2).Range.Text
‘ 1. remove last two chars: 0x0D,0x07
‘gFuncName = Mid(gFuncName, 1, Len(gFuncName) – 2)
gFuncName = Mid(gFuncName, 1, InStr(gFuncName, vbCr) – 1)

gFuncDesc = funcTbl.Columns(constFuncDescColIdx).Cells(2).Range.Text
‘ 1. remove last two chars: 0x0D,0x07
gFuncDesc = Mid(gFuncDesc, 1, Len(gFuncDesc) – 2)
‘ 2. replace other 0x0D with space
gFuncDesc = Replace(gFuncDesc, vbCr, Space(1))

‘gFuncCmd = funcTbl.Columns(constFuncCmdColIdx).Cells(2)
‘ 1. remove last two chars: 0x0D,0x07
‘gFuncCmd = Mid(gFuncCmd, 1, InStr(gFuncCmd, vbCr) – 1)

‘get PAP command from heading string
gFuncCmd = Trim(Mid(strHeading, 1, InStr(strHeading, “/”) – 1))

End Function

Function processNote(strNote As String)

‘ 1. remove last two chars: 0x0D,0x07
strNote = Mid(strNote, 1, Len(strNote) – 2)

‘ 2. replace other 0x0D with space
‘strNote = Replace(strNote, Chr(13), Chr(32))
strNote = Replace(strNote, vbCr, Space(1))

‘ 3. handle special characters
strNote = handleSpecialCharacter(strNote)

gNote = strNote

End Function

Function groupToOneLine(cmd, param, strNote)
Dim oneLine

oneLine = vbTab & _
        “<MenuCmd cmd='” & cmd & _
        “‘ param='” & param & _
        “‘> <note>” & strNote & “</note> </MenuCmd>”

‘ return value
groupToOneLine = oneLine

End Function

Function WriteXmlHead()

printToOutputFile (“<?xml version=””” & constXmlVer & “”” encoding=””ISO-8859-1″” ?>”)
printToOutputFile (“<!–” & Space(4) & constPrjName & ” Plug and Play Settings” & Space(4) & “–>”)
printToOutputFile (cbCr)
printToOutputFile (“<Product name='” & constPrjName & “‘>”)
printToOutputFile (“<EditDate lastModified='” & Date & “‘></EditDate>”)
printToOutputFile (cbCr)

End Function

Function writeFuncHeader()
printToOutputFile (“<PlugPlay name='” & gFuncName & “‘>”)
printToOutputFile (vbTab & “<Description>” & gFuncDesc & “</Description>”)
printToOutputFile (vbTab & “<Tag>” & gFuncCmd & _
                    “</Tag> <Note>Major menu command for the following parameters</Note>”)
End Function

Function writeFuncTail()
‘output TODO line if necessary
If gNeedOutputTodoLine = True Then
    Call printToOutputFile(constTodoLine)
    gNeedOutputTodoLine = False
End If

Call printToOutputFile(“</PlugPlay>” & vbCrLf)
End Function

Function WriteXmlTail()

printToOutputFile (“</Product>”)

End Function

Function openFileWithNotepad(strFileName As String)
    Dim fileID As Double
    fileID = Shell(“C:WINDOWSnotepad.exe” & Space(1) & strFileName, vbNormalFocus)
End Function

Sub ExtractMenuCmdToXmlFile()

‘ Extract the valid menu commands from a word file to a XML file

‘ Main Prerequisite:
‘ 1.Charpter 2 heading is the string : constCh2Heading
‘ 2.the “Menu command table” and “Function table” must be same as description in
‘   checkFuncDescTableValid() and checkTableValid()
‘ 3. the valid menu command must be same as description in checkCmdValid()
‘ …

Dim posStart, posEnd, posPreEnd, posPreStart
Dim posCurFuncStart, posCurFuncEnd
Dim posNextFuncStart, posNextFuncEnd

Dim curFuncHeadingNr ‘ heading number for current func heading
Dim selHeadingNr ‘heading number for current selection, may be null for text copied from newMaster.doc, which include heading 3

Dim constLenCh2
Dim strSelHeading As String ‘string of selected heading
Dim curFuncSel As Selection

Dim curTblInFunc As Table

Dim isLastFunc As Boolean

‘init values
constLenCh2 = Len(constCh2Heading)
isLastFunc = False

gProcessingInfo.curRowIdxInTbl = 0
gProcessingInfo.curTblIdxInFunc = 0

‘record summary log info
gLogSummary.totalTblNr = 0

gLogSummary.validNr = 0
gLogSummary.invalidNr = 0

gLogSummary.blankNr = 0
gLogSummary.errorNr = 0
gLogSummary.includeQuestionMarkNr = 0
gLogSummary.notcareNr = 0
gLogSummary.tbdNr = 0
gLogSummary.unsupportedNr = 0

‘1. create log and output file and output xml header info
Call createLogFile
Call createOutputFile
Call WriteXmlHead

‘2. goto Chapter 2.1, the start of functions need to process
MsgBox “Now start extracting valid menu commands from: ” & vbCrLf & ActiveDocument.FullName

outputLogInfo “[” & Date & Space(2) & Time & “]”
outputLogInfo “This is log for extracting valid menu commands from file:” & vbCrLf & ActiveDocument.FullName
outputLogInfo “Go to find chapter 2 heading text, expecting is:” & constCh2Heading

ActiveDocument.Select
Selection.GoTo What:=wdGoToHeading, Which:=wdGoToFirst ‘go to first heading
Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend ‘select current line
strSelHeading = Mid(Selection.Text, 1, InStr(Selection.Text, vbCr))
‘move to next heading until it is “2   Translating Procedure for Functions”
Do While StrComp(Left(strSelHeading, constLenCh2), Left(constCh2Heading, constLenCh2)) <> 0
    ‘outputLogInfo “Chapter[” & Selection.Bookmarks(“headinglevel”).Range.ListFormat.ListString & “]” & strSelHeading

    ‘goto next heading and select that line
    Selection.GoTo What:=wdGoToHeading, Which:=wdGoToNext, Count:=1
    Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend

    ‘ get valuable string, remove the text after ‘CR’
    strSelHeading = Mid(Selection.Text, 1, InStr(Selection.Text, vbCr))
Loop

outputLogInfo “Found chapter 2 heading text:” & Selection.Text

‘move to 2.1
outputLogInfo “Move to chapter 2.1”

Selection.GoTo What:=wdGoToHeading, Which:=wdGoToNext, Count:=1 ‘now it is must be the 2.1
Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
strSelHeading = Mid(Selection.Text, 1, InStr(Selection.Text, vbCr))

‘record start point of this charpter
posCurFuncStart = Selection.Start
posCurFuncEnd = Selection.End

‘3. process each 2.XXX
‘ the heading text is like: PAP_Command_Name(fixed 6 char) / Function_Name(variable length)
‘ each 2.XXX charpter include several tables
‘   (1)the first table must the Function table, containing function name and function description
‘   (2)the others table is the menu command table, containg valid and invalid menu command for extracting

‘==================== find 2.xxx start ====================
outputLogInfo “Now will process each function in chapter 2:” & vbCrLf
outputLogInfo String(60, “-“) ‘ ‘show many “-” as divison line

continue_next_func:

‘now, must be select the 2.xxx line
curFuncHeadingNr = Selection.Bookmarks(“headinglevel”).Range.ListFormat.ListString
strSelHeading = Mid(Selection.Text, 1, InStr(Selection.Text, vbCr))
‘outputLogInfo “—before loop:[” & curFuncHeadingNr & “]:” & strSelHeading

‘move to heading which after the 2.XXX
‘ it may be others or is current 2.(xxx + 1) or 3
Selection.GoTo What:=wdGoToHeading, Which:=wdGoToNext, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
selHeadingNr = Selection.Bookmarks(“headinglevel”).Range.ListFormat.ListString
While (selHeadingNr Like “2.#*”) = False
    If (selHeadingNr Like “3*”) = True Then
        ‘found ch3, so is last func to process
        isLastFunc = True
       
        GoTo last_function
    End If

    Selection.GoTo What:=wdGoToHeading, Which:=wdGoToNext, Count:=1
    Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
    selHeadingNr = Selection.Bookmarks(“headinglevel”).Range.ListFormat.ListString
Wend

last_function:
‘record for later use
posNextFuncStart = Selection.Start
posNextFuncEnd = Selection.End

‘select the whole sub chapter 2.XXX
Selection.Start = posCurFuncStart
Selection.End = posNextFuncStart

‘——————– func process start ——————–

‘ process each function

‘reset log info
gLogInFunc.totalTblNr = 0

gLogInFunc.validNr = 0
gLogInFunc.invalidNr = 0

gLogInFunc.blankNr = 0
gLogInFunc.notcareNr = 0
gLogInFunc.tbdNr = 0
gLogInFunc.unsupportedNr = 0
gLogInFunc.includeQuestionMarkNr = 0
gLogInFunc.errorNr = 0

‘gErrInFunc.errNrPerFunc = 0
gErrInFunc.curErrItemIdx = 1 ‘start from first

‘reset others
gNeedOutputTodoLine = False

‘calc info
gLogInFunc.totalTblNr = Selection.Tables.Count

‘record summary log info
gLogSummary.totalTblNr = gLogInFunc.totalTblNr + gLogSummary.totalTblNr

‘the first table, must be the func name+description+command table
If checkFuncDescTableValid(Selection.Tables(1)) = False Then
    outputLogInfo “[” & curFuncHeadingNr & “] ” & strSelHeading
    outputLogInfo “Invalid Function Table, So not process this function”
    GoTo funcTableInvalid
End If

‘after check, now it must be valid table
‘get func table info
Call processFuncTable(Selection.Tables(1), strSelHeading)
‘write func header
Call writeFuncHeader

outputLogInfo “Chapter[” & curFuncHeadingNr & “] ” & gFuncName & ” | ” & gFuncCmd & ” :”
outputLogInfo “Total Tables=” & vbTab & gLogInFunc.totalTblNr

‘ from second to last, is the tables need to process
For gProcessingInfo.curTblIdxInFunc = 2 To gLogInFunc.totalTblNr
    Set curTblInFunc = Selection.Tables(gProcessingInfo.curTblIdxInFunc)
   
    If checkTableValid(curTblInFunc) = True Then
        Call processTable(Selection.Tables(gProcessingInfo.curTblIdxInFunc))
   
    Else ‘Invalid Table

        GoTo NextTable
    End If

NextTable:
Next gProcessingInfo.curTblIdxInFunc

If gLogInFunc.validNr = 0 Then
    ‘ if none valid table then should be not-processed func, need todo later
    gNeedOutputTodoLine = True
End If
‘write func tail
Call writeFuncTail

‘record summary log info
gLogSummary.validNr = gLogInFunc.validNr + gLogSummary.validNr
gLogSummary.invalidNr = gLogInFunc.invalidNr + gLogSummary.invalidNr

gLogSummary.blankNr = gLogSummary.blankNr + gLogInFunc.blankNr
gLogSummary.includeQuestionMarkNr = gLogSummary.includeQuestionMarkNr + gLogInFunc.includeQuestionMarkNr
gLogSummary.notcareNr = gLogSummary.notcareNr + gLogInFunc.notcareNr
gLogSummary.tbdNr = gLogSummary.tbdNr + gLogInFunc.tbdNr
gLogSummary.unsupportedNr = gLogSummary.unsupportedNr + gLogInFunc.unsupportedNr
gLogSummary.errorNr = gLogSummary.errorNr + gLogInFunc.errorNr

Call outputLogForEachFunc

‘——————– func process end ——————–
funcTableInvalid:
outputLogInfo String(60, “-“) ‘ ‘show many “-” as divison line

‘prepare for next func
Selection.Start = posNextFuncStart
Selection.End = posNextFuncEnd

posCurFuncStart = posNextFuncStart
posCurFuncEnd = posNextFuncEnd

If isLastFunc = False Then  ‘ is not the last func, then continue process
    GoTo continue_next_func
End If
‘==================== find 2.xxx end ====================

outputLogInfo “Extracting valid menu commands completed.”

FailToFindCh2Heading:
‘4. output xml tail
Call WriteXmlTail
Call outputLogSummary

‘5. close files
Call closeOutputFile
Call closeLogFile

‘after process, go to document start
Selection.GoTo What:=wdGoLine, Which:=wdGoToFirst ‘go to first line

MsgBox “Process completed.” & vbCrLf & “Processing details please refer log file: ” _
            & gLogFullFileName & vbCrLf & “Now open result file: ” & gOutputFileNameWithPath

‘open it using Notepad
openFileWithNotepad (gOutputFileNameWithPath)

End Sub

转载请注明:在路上 » [version:2010-01-14] extract menu command from word to xml file

发表我的评论
取消评论

表情

Hi,您需要填写昵称和邮箱!

  • 昵称 (必填)
  • 邮箱 (必填)
  • 网址
81 queries in 0.167 seconds, using 22.21MB memory