‘Attribute VB_Name = “extractMenuCmdToXml”
Public Const constOutputXmlFileName As String = “D:2300_PAP_Settings.xml”
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>”
‘ Function Name and Function Description Table
Public Const constTotalFuncTblColCnt As Integer = 2 ‘total column number of valid Function table
Public Const constStrFuncName As String = “FunctionName”
Public Const constStrFuncDesc As String = “FunctionDescription”
Public Const constFuncNameColIdx As Integer = 1 ‘Function Name column number
Public Const constFuncDescColIdx As Integer = 2 ‘FunctionDescription column number
‘ Menu Command and Description Table
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 gCmd
Public gParam
Public gNote
Public gFuncName
Public gFuncDesc
‘ output file realted
Public gFileNum As Integer
Public gDestFile As String
Public gNeedOutputTodoLine ‘ when include TBD/?/blank, should output TODO line
Function checkTableValid(tableToChk As table, tblNr)
‘ 1. the column must be 5:
‘ “Bit Position” “Bit Value” “Function” “Menu Command” “Description”
‘ 2. column 4 and 5 must be: “Menu Command” “Description”
Dim valid
‘valid = 0
valid = 1
If tableToChk.Columns.Count <> constTotalTblColCnt Then
valid = 0
MsgBox “Table[” & tblNr & “] Invalid for Column Count=” & tableToChk.Columns.Count & ” !!!”
GoTo AlreadyCheck
End If
If StrComp(Left(tableToChk.Columns(constMenuCmdColIdx).Cells(1), Len(constStrMenuCmd)), constStrMenuCmd) <> 0 Then
valid = 0
MsgBox “Table[” & tblNr & “] Invalid for Menu Command column string=” & tableToChk.Columns.Count & ” !!!”
GoTo AlreadyCheck
End If
If StrComp(Left(tableToChk.Columns(constDescColIdx).Cells(1), Len(constStrDescription)), constStrDescription) <> 0 Then
valid = 0
MsgBox “Table[” & tblNr & “] Invalid for Description column string=” & tableToChk.Columns.Count & ” !!!”
GoTo AlreadyCheck
End If
AlreadyCheck:
‘ return value
checkTableValid = valid
End Function
Function checkFuncDescTableValid(tableToChk As table)
‘ 1. the column must be 2:
‘ “FunctionName” “FunctionDescription”
‘ 2. column 1 and 2 must be: “FunctionName” “FunctionDescription”
Dim valid
valid = 0
If tableToChk.Columns.Count = constTotalFuncTblColCnt Then
If StrComp(Left(tableToChk.Columns(constFuncNameColIdx).Cells(1), Len(constStrFuncName)), constStrFuncName) = 0 Then
If StrComp(Left(tableToChk.Columns(constFuncDescColIdx).Cells(1), Len(constStrFuncDesc)), constStrFuncDesc) = 0 Then
If StrComp(tableToChk.Columns(constFuncNameColIdx).Cells(2), vbCr & Chr(7)) <> 0 Then
valid = 1
End If
End If
End If
End If
AlreadyCheck:
‘ return value
checkFuncDescTableValid = valid
End Function
Function checkCmdValid(cmd)
‘ check whether the command is valid
Dim isValid
isValid = 1
‘ 1. TBD, should handle this first for step3 “other invalid command of short len” will omit this if do this step after step3
If Left(cmd, Len(constStrTBD)) = constStrTBD Then
gNeedOutputTodoLine = 1 ‘for later output the TODO line
isValid = 0
GoTo AlreadyCheck
End If
‘ 2. blank
If StrComp(cmd, vbCr & Chr(7)) = 0 Then
‘ while blank, has check its len is 2, is 0x13=vbCr and 0x07=[BEL]
gNeedOutputTodoLine = 1 ‘for later output the TODO line
isValid = 0
‘MsgBox isValid & “: ” & Asc(Left(cmd, 1)) & ” ” & Asc(Right(cmd, 1))
GoTo AlreadyCheck
End If
‘ 3. other invalid command of short len
If Len(cmd) < (constMenuCmdTagLen + 1) Then
‘ other misc invaid command, for valid command length should at least large than the (main+sub) tag len and at least one character param
isValid = 0
GoTo AlreadyCheck
End If
‘ 4. include “?”
If InStr(cmd, “?”) > 0 Then
gNeedOutputTodoLine = 1 ‘for later output the TODO line
‘ found ?, so invalid
isValid = 0
GoTo AlreadyCheck
End If
‘ 5. NOT_CARE
If Left(cmd, Len(constStrNotCare)) = constStrNotCare Then
isValid = 0
GoTo AlreadyCheck
End If
‘ 6.Unsupported
If Left(cmd, Len(constStrUnsupported)) = constStrUnsupported Then
isValid = 0
GoTo AlreadyCheck
End If
‘ all other left, are valid command
AlreadyCheck:
checkCmdValid = isValid
End Function
Function processCmd(strCmd, tblIdx, rowIdx)
‘ extract cmd and param
Dim paramLen
Dim pointPos
pointPos = InStr(strCmd, “.”)
If pointPos <= 0 Then
MsgBox “Invalid command: ” & strCmd
Exit Function
End If
gCmd = Left(strCmd, constMenuCmdTagLen)
paramLen = pointPos – constMenuCmdTagLen – 1 ‘ 1 is the point “.”
If paramLen < 1 Then
‘invalid param if not 99XXXX type command
If StrComp(Left(strCmd, 2), “99”) <> 0 Then
MsgBox “Invalid Menu Command: Table[” & tblIdx & “] Row[” & rowIdx & “]=” & strCmd & “param len=” & paramLen
End If
End If
gParam = Mid(strCmd, constMenuCmdTagLen + 1, paramLen)
End Function
Function processNote(note)
‘ 1. remove last two chars: 0x0D,0x07
‘ 2. replace other 0x0D with space
‘ 3. handle special character in XML:
‘ < < 小于
‘ > > 大于
‘ & & 和号
‘ ' ‘ 单引号
‘ " ” 引号
Dim noteLen
‘ 1. remove last two chars: 0x0D,0x07
noteLen = Len(note) – 2
‘noteLen = Len(note)
note = Mid(note, 1, noteLen)
‘ 2. replace other 0x0D with space
‘note = Replace(note, Chr(13), Chr(32))
note = Replace(note, vbCr, Space(1))
‘ 3. handle special character in XML:
‘ < < 小于
‘ > > 大于
‘ & & 和号
‘ ' ‘ 单引号
‘ " ” 引号
‘ must handle this first for other 3 include “&”
note = Replace(note, Chr(38), “&”)
note = Replace(note, Chr(60), “<”)
note = Replace(note, Chr(62), “>”)
note = Replace(note, Chr(96), “'”)
note = Replace(note, Chr(34), “"”)
gNote = note
‘MsgBox “gNoteLen:” & Len(gNote) & ” ” & gNote
End Function
Function groupToOneLine(cmd, param, note)
Dim oneLine
oneLine = vbTab & “<MenuCmd cmd='” & cmd & _
“‘ param='” & param & _
“‘> <note>” & note & “</note> </MenuCmd>”
‘ return value
groupToOneLine = oneLine
End Function
Function processFuncName(strFuncName)
‘ 1. remove last two chars: 0x0D,0x07
strFuncName = Mid(strFuncName, 1, Len(strFuncName) – 2)
gFuncName = strFuncName
End Function
Function processFuncDesc(strFuncDesc)
‘ 1. remove last two chars: 0x0D,0x07
strFuncDesc = Mid(strFuncDesc, 1, Len(strFuncDesc) – 2)
‘ 2. replace other 0x0D with space
strFuncDesc = Replace(strFuncDesc, vbCr, Space(1))
gFuncDesc = strFuncDesc
End Function
Function createOutputFile()
Dim openFileOK
‘openFileOK = 1
‘MsgBox openFileOK
‘ 1. create an XML file
gDestFile = constOutputXmlFileName
‘ 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 = 0
MsgBox “Cannot open filename ” & gDestFile
End If
‘ Turn error checking on.
On Error GoTo 0
createOutputFile = openFileOK
‘MsgBox “after ” & openFileOK
End Function
Function printToOutputFile(strToPrint)
Print #gFileNum, strToPrint
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 WriteXmlTail()
If gNeedOutputTodoLine = 1 Then
Call printToOutputFile(constTodoLine)
gNeedOutputTodoLine = 0
Else
If tblHandledInCurrFunc = 0 Then ‘if not handle any valid table in this func, so need add TODO line
Call printToOutputFile(constTodoLine)
End If
End If
printToOutputFile (“</PlugPlay>” & vbCrLf)
printToOutputFile (“</Product>”)
End Function
Function closeOutputFile()
‘ Close destination file.
Close #gFileNum
End Function
Sub extractMenuCmdToXml()
‘
‘ Extract the valid menu command to a XML file
‘
Dim DocAuthor
Dim TotalTblNr
Dim CurTblNr
Dim TotoalRowNrInMenuCmdCol
Dim rowIdx, startRowIdx
Dim strMenuCommand
Dim stringLen
Dim tableToHandle As table
Dim tblHandled, tblFailed, tblHandledInCurrFunc
Dim funcNr, needGenFuncTail
needGenFuncTail = 0
funcNr = 0
tblHandled = 0
tblFailed = 0
tblHandledInCurrFunc = -1 ‘init to invalid
gNeedOutputTodoLine = 0
‘ create output file
Call createOutputFile
‘If createOutputFile <= 0 Then
‘ GoTo CreateFileFail
‘End If
‘ write header info
Call WriteXmlHead
DocAuthor = Application.UserName
‘MsgBox DocAuthor, vbInformation, “Document Author”
TotalTblNr = ActiveDocument.Tables.Count
MsgBox Title:=”Before Processing”, _
Prompt:=”Total ” & TotalTblNr & ” tables to process, Please wait …” & _
vbCr & “This Document Author: ” & DocAuthor
startRowIdx = 2 ‘exclude “Menu Command” column
‘ process each table in the word file
For CurTblNr = 1 To TotalTblNr
‘For CurTblNr = 1 To 1
Set tableToHandle = ActiveDocument.Tables(CurTblNr)
If checkFuncDescTableValid(tableToHandle) = 1 Then
If needGenFuncTail = 1 Then
If gNeedOutputTodoLine = 1 Then
Call printToOutputFile(constTodoLine)
gNeedOutputTodoLine = 0
End If
If tblHandledInCurrFunc = 0 Then ‘if not handle any valid table in this func, so need add TODO line
Call printToOutputFile(constTodoLine)
End If
Call printToOutputFile(“</PlugPlay>” & vbCrLf)
needGenFuncTail = 0
End If
Call processFuncName(tableToHandle.Columns(constFuncNameColIdx).Cells(2))
Call processFuncDesc(tableToHandle.Columns(constFuncDescColIdx).Cells(2))
Call printToOutputFile(“<PlugPlay name='” & gFuncName & “‘>”)
Call printToOutputFile(vbTab & “<Description>” & gFuncDesc & “</Description>”)
tblHandledInCurrFunc = 0
needGenFuncTail = 1
GoTo NextTable
End If
If checkTableValid(tableToHandle, CurTblNr) = 1 Then ‘valid table
TotoalRowNrInMenuCmdCol = tableToHandle.Columns(constMenuCmdColIdx).Cells.Count
For rowIdx = startRowIdx To TotoalRowNrInMenuCmdCol
strMenuCommand = tableToHandle.Columns(constMenuCmdColIdx).Cells(rowIdx)
strMenuCommand = Trim(strMenuCommand)
‘stringLen = Len(strMenuCommand)
‘ only process it when valid
If checkCmdValid(strMenuCommand) = 1 Then
‘ process valid command
‘ MsgBox Title:=”Current Table: ” & CurTblNr, _
‘ Prompt:=”Idx:” & rowIdx & ” valid:” & Valid & ” len:” _
‘ & stringLen & ” Cmd:” & strMenuCommand
‘ 1. process cmd and param
Call processCmd(strMenuCommand, CurTblNr, rowIdx)
‘processCmd (strMenuCommand)
gNote = tableToHandle.Columns(constDescColIdx).Cells(rowIdx)
‘ 2. process note
Call processNote(gNote)
‘ 3. Write all info to output file
Call printToOutputFile(groupToOneLine(gCmd, gParam, gNote))
Else ‘invalid command
‘MsgBox “Command” & rowIdx & “Invalid in Table ” & CurTblNr ” !!!”
GoTo NextCommand
End If
NextCommand:
Next rowIdx
tblHandledInCurrFunc = tblHandledInCurrFunc + 1
tblHandled = tblHandled + 1
Else ‘Invalid Table
tblFailed = tblFailed + 1
‘MsgBox “Invalid Table ” & CurTblNr & ” !!!”
GoTo NextTable
End If
NextTable:
Next CurTblNr
‘ write tail info
Call WriteXmlTail
CreateFileFail:
Call closeOutputFile
MsgBox Title:=”After Processing”, _
Prompt:=”Menu Command Tables: ” & “Handled=” & tblHandled & “, Failed=” & tblFailed & vbCrLf & _
“Output File: ” & constOutputXmlFileName
End Sub
转载请注明：在路上 » [completed] word vba: extract Menu Command from word file