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

[completed] word vba: extract Menu Command from word file

VBA crifan 2262浏览 0评论

‘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:
‘   &lt;       <   小于
‘   &gt;       >   大于
‘   &amp;      &   和号
‘   &apos;     ‘   单引号
‘   &quot;     ”   引号

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:
‘   &lt;       <   小于
‘   &gt;       >   大于
‘   &amp;      &   和号
‘   &apos;     ‘   单引号
‘   &quot;     ”   引号
‘ must handle this first for other 3 include “&”
note = Replace(note, Chr(38), “&amp;”)
note = Replace(note, Chr(60), “&lt;”)
note = Replace(note, Chr(62), “&gt;”)
note = Replace(note, Chr(96), “&apos;”)
note = Replace(note, Chr(34), “&quot;”)

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

发表我的评论
取消评论

表情

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

  • 昵称 (必填)
  • 邮箱 (必填)
  • 网址
83 queries in 0.208 seconds, using 22.15MB memory