'parse twb to word
use word macro
Sub ReadXML()
'ParseTwb
'20210129
Dim XDoc As Object
Dim sCataloge, sID, sCaption, sDataType, sFormate, sValue, sFormula As String
Dim iParameterSN, iDataSourceSN, iColumnSN, iWindowSN, iFormulaSN As Integer
Set XDoc = CreateObject("MSXML2.DOMDocument")
XDoc.async = False: XDoc.validateOnParse = False
'把這個路徑改成您要PARSE的TWB檔案路徑
XDoc.Load ("C:\Users\z0779\Desktop\test.twb")
'========【Parameters】==========================================================================
Selection.TypeText Text:="【Parameters】" & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbCr
Selection.TypeText Text:="SN" & vbTab & "Cataloge" & vbTab & "Name" & vbTab & "Caption" & vbTab & "DataType" & vbTab & "Formate" & vbTab & "Value" & vbCr
Set ndParameters = XDoc.SelectNodes("/workbook/datasources/datasource[@name='Parameters']/column")
iParameterSN = 0
For Each pm In ndParameters
iParameterSN = iParameterSN + 1
sCataloge = "Parameters"
sID=""
sCaption=""
sDataType=""
sFormate=""
sValue=""
For Each attr In pm.Attributes
Select Case attr.nodeName
Case "name"
sID = attr.NodeValue
Case "caption"
sCaption = attr.NodeValue
Case "datatype"
sDataType = attr.NodeValue
Case "default-format"
sFormate = attr.NodeValue
Case "value"
sValue = attr.NodeValue
End Select
Next
Selection.TypeText Text:= _
CStr(iParameterSN) & vbTab _
& sCataloge & vbTab _
& sID & vbTab _
& sCaption & vbTab _
& sDataType & vbTab _
& sFormate & vbTab _
& sValue & vbCr
Next
iParameterSN = 0
sCataloge = ""
sID = ""
sCaption = ""
sDataType = ""
sFormate = ""
sValue = ""
Set attr = Nothing
Set pm = Nothing
Set ndParameters = Nothing
Selection.TypeText Text:=vbCr & vbCr
'========【DataSource】==========================================================================
Selection.TypeText Text:="【DataSource】" & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbCr
Selection.TypeText Text:="SN" & vbTab & "Cataloge" & vbTab & "Name" & vbTab & "Caption" & vbTab & "DataType" & vbTab & "Formate" & vbTab & "Value" & vbCr
Set ndDataSources = XDoc.SelectNodes("/workbook/datasources/datasource[@name!='Parameters']")
iDataSourceSN = 0
iColumnSN = 0
For Each ds In ndDataSources
iDataSourceSN = iDataSourceSN + 1
sCataloge = "datasource"
sID=""
sCaption=""
sDataType=""
sFormate=""
sValue=""
For Each attr In ds.Attributes
Select Case attr.nodeName
Case "name"
sID = attr.NodeValue
Case "caption"
sCaption = attr.NodeValue
Case "datatype"
sDataType = attr.NodeValue
Case "default-format"
sFormate = attr.NodeValue
Case "value"
sValue = attr.NodeValue
End Select
Next
Selection.TypeText Text:= _
"DataSource " & CStr(iDataSourceSN) & vbTab _
& sCataloge & vbTab _
& sID & vbTab _
& sCaption & vbTab _
& sDataType & vbTab _
& sFormate & vbTab _
& sValue & vbCr
sDataSourceID = sID
'iDataSourceSN = 0
sCataloge = ""
sID = ""
sCaption = ""
sDataType = ""
sFormate = ""
sValue = ""
Set attr = Nothing
'========【Column】==========================================================================
Set ndColumns = XDoc.SelectNodes("/workbook/datasources/datasource[@name='" & sDataSourceID & "']/column")
For Each cl In ndColumns
iColumnSN = iColumnSN + 1
sCataloge = "column"
sID=""
sCaption=""
sDataType=""
sFormate=""
sValue=""
For Each attr In cl.Attributes
Select Case attr.nodeName
Case "name"
sID = attr.NodeValue
Case "caption"
sCaption = attr.NodeValue
Case "datatype"
sDataType = attr.NodeValue
Case "default-format"
sFormate = attr.NodeValue
Case "value"
sValue = attr.NodeValue
End Select
Next
Set attr = Nothing
Selection.TypeText Text:= _
CStr(iColumnSN) & vbTab _
& sCataloge & vbTab _
& sID & vbTab _
& sCaption & vbTab _
& sDataType & vbTab _
& sFormate & vbTab _
& sValue & vbCr
'make hyperlink to bookmark
'If Trim(sCaption) <> "" Then
'sBookMarkName = sCaption
'sBookMarkName = Replace(sBookMarkName, "%", "％")
'sBookMarkName = Replace(sBookMarkName, ".", "‧")
'sBookMarkName = Replace(sBookMarkName, " ", "＿")
'sBookMarkName = Replace(sBookMarkName, "(", "（")
'sBookMarkName = Replace(sBookMarkName, ")", "）")
'sBookMarkName = Replace(sBookMarkName, "|", "｜")
'sBookMarkName = Replace(sBookMarkName, "-", "－")
' sBookMarkName = "B" & CStr(iDataSourceSN) & "_" & CStr(iColumnSN)
' ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, _
' Address:="", SubAddress:=sBookMarkName, ScreenTip:="click to see {" & sCaption & "} formula"
', TextToDisplay:=sCaption
'End If
Next
iColumnSN = 0
sCataloge = ""
'sDataSourceID = ""
sID = ""
sCaption = ""
sDataType = ""
sFormate = ""
sValue = ""
Set attr = Nothing
Set cl = Nothing
Set ndColumns = Nothing
Selection.TypeText Text:=vbCr
Next
sCataloge = ""
sID = ""
sCaption = ""
sDataType = ""
sFormate = ""
sValue = ""
Set attr = Nothing
Set ds = Nothing
Set ndDataSources = Nothing
Selection.TypeText Text:=vbCr
'========【pages(windows)】==========================================================================
Selection.TypeText Text:="【Windows】" & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbCr
Selection.TypeText Text:="SN" & vbTab & "Cataloge" & vbTab & "Name" & vbTab & "Caption" & vbTab & "DataType" & vbTab & "Formate" & vbTab & "Value" & vbCr
Set wds = XDoc.SelectNodes("//window")
iWindowSN = 0
For Each wd In wds
iWindowSN = iWindowSN + 1
sCataloge = "window"
sID=""
sCaption=""
sDataType=""
sFormate=""
sValue=""
For Each attr In wd.Attributes
Select Case attr.nodeName
Case "class"
sDataType = attr.NodeValue
Case "name"
sCaption = attr.NodeValue
End Select
Next
If sDataType = "dashboard" Then
'get worksheets in dashboard under windows node
Set wks = XDoc.SelectNodes("/workbook/windows/window[@class='dashboard' and @name='" & sCaption & "']/viewpoints/viewpoint/@name")
For Each wk In wks
sValue = sValue & "worksheet[" & wk.NodeValue & "], "
Next
If sValue <> "" Then sValue = Left(sValue, Len(sValue) - 2)
Set wk = Nothing
Set wks = Nothing
'get worksheets in story under dashboards node
Set wks = XDoc.SelectNodes("/workbook/dashboards/dashboard[@name='" & sCaption & "' and @type='storyboard']/zones/zone/zone/zone/flipboard/story-points/story-point/@captured-sheet")
'Set wks = XDoc.SelectNodes("//@captured-sheet")
For Each wk In wks
'Debug.Print wk.ParentNode.SelectNodes("@name").Item(0).Value
'Debug.Print wk.NodeValue
sValue = sValue & "window[" & wk.NodeValue & "], "
sDataType = "story"
Next
If sValue <> "" Then sValue = Left(sValue, Len(sValue) - 2)
Set wk = Nothing
Set wks = Nothing
End If
Selection.TypeText Text:= _
CStr(iWindowSN) & vbTab _
& sCataloge & vbTab _
& sID & vbTab _
& sCaption & vbTab _
& sDataType & vbTab _
& sFormate & vbTab _
& sValue & vbCr
sID = ""
sCaption = ""
sDataType = ""
sFormate = ""
sValue = ""
Set attr = Nothing
Next
iWindowSN = 0
sCataloge = ""
Set wd = Nothing
Set wds = Nothing
ActiveDocument.Range.ConvertToTable Separator:=vbTab
ActiveDocument.Tables(1).AutoFormat _
Format:=wdTableFormatColorful2 _
, ApplyBorders:=True _
, ApplyFont:=True _
, ApplyColor:=True
Selection.TypeText Text:=vbCr & vbCr
'========【formula】==========================================================================
Selection.TypeText Text:="【Formula】" & vbCr
'---get formula-----------
'Set ndColumns = XDoc.SelectNodes("/workbook/datasources/datasource[@name='" & sDataSourceID & "']/column")
'Set ndColumns = XDoc.SelectNodes("/workbook/datasources/datasource/column")
Set ndColumns = XDoc.SelectNodes("/workbook/datasources/datasource[@name!='Parameters']/column")
iFormulaSN = 0
sDataSourceID = ""
sDataSourceCaption = ""
For Each cl In ndColumns
sDataSourceID = cl.ParentNode.SelectNodes("@name").Item(0).Value
If sDataSourceID <> "Parameters" Then sDataSourceCaption = cl.ParentNode.SelectNodes("@caption").Item(0).Value
sCataloge = "column"
sID=""
sCaption=""
sDataType=""
sFormate=""
sValue=""
For Each attr In cl.Attributes
Select Case attr.nodeName
Case "name"
sID = attr.NodeValue
Case "caption"
sCaption = attr.NodeValue
End Select
Next
Set attr = Nothing
sXPath = "/workbook/datasources/datasource[@name='" & sDataSourceID & "']/column[@name='" & sID & "']/calculation/@formula"
If XDoc.SelectNodes(sXPath).Length = 1 Then
sFormula = XDoc.SelectNodes(sXPath).Item(0).NodeValue
iFormulaSN = iFormulaSN + 1
'---replace formula content with column caption-----------
If InStr(1, sFormula, "[Parameter", 1) > 0 Or InStr(1, sFormula, "[Calculation_", 1) > 0 Then
sXPath = "/workbook/datasources/datasource[@name='Parameters' or @name='" & sDataSourceID & "']/column[@name!='" & sID & "']"
For Each clOther In XDoc.SelectNodes(sXPath)
For Each attr In clOther.Attributes
Select Case attr.nodeName
Case "name"
sClOtherID = attr.NodeValue
Case "caption"
sClOtherCaption = attr.NodeValue
End Select
Next
Set attr = Nothing
If InStr(1, sFormula, sClOtherID, 1) > 0 Then
sFormula = Replace(sFormula, sClOtherID, sClOtherCaption)
End If
Next
End If
Set clOther = Nothing
sBookMarkName = CStr(iFormulaSN)
sLargeFormula = sLargeFormula & "===============================================================================================================================================================" & vbCr _
& sBookMarkName & "." & sDataSourceCaption & "." & sID & "{" & sCaption & "}" & vbCr _
& sFormula & vbCr
Selection.TypeText Text:=sLargeFormula
'make bookmark
'If Trim(sCaption) <> "" Then
'sBookMarkName = sCaption
'sBookMarkName = Replace(sBookMarkName, "%", "％")
'sBookMarkName = Replace(sBookMarkName, ".", "‧")
'sBookMarkName = Replace(sBookMarkName, " ", "＿")
'sBookMarkName = Replace(sBookMarkName, "(", "（")
'sBookMarkName = Replace(sBookMarkName, ")", "）")
'sBookMarkName = Replace(sBookMarkName, "|", "｜")
'sBookMarkName = Replace(sBookMarkName, "-", "－")
'ActiveDocument.Bookmarks.Add Name:=sBookMarkName
' ActiveDocument.Bookmarks.Add Name:=sBookMarkName
'End If
sLargeFormula = ""
End If
Next
iFormulaSN = 0
sXPath = ""
sDataSourceID = ""
sDataSourceCaption = ""
sCataloge = ""
sID = ""
sCaption = ""
sDataType = ""
sFormate = ""
sValue = ""
sFormula = ""
Set attr = Nothing
Set cl = Nothing
Set ndColumns = Nothing
Set dColumn = Nothing
Set XDoc = Nothing
End Sub