XML宣言「」を「」へ置換

実現したいこと

XML宣言<?xml version="1.0"?>を

へ置換

前提

自社管理しているデータ(Excel)をVBA経由にてXMLファイルを作成する
その際に、XML宣言が<?xml version="1.0"?>のみで動作しない

正しい書き方の<?xml version="1.0" encoding="UTF-8" standalone="yes"?>へ置換したい

  '置換前文字列
beforeStr = "<?xml version="1.0"?>"
'置換後文字列
afterStr = "<?xml version="1.0" encoding="UTF-8" standalone="yes"?>"

箇所で
コンパイル エラー:
修正候補:ステートメントの最後

と表示されました
"1.0"を””1.0””と書き換えますが、正しく置換はできませんでした。

手動でと言う意見もありますが、可能であればマクロを使用しての完成を行いたいと思っています。
他に良い方法がありましたらご教授いただければ幸いです。
(ネットに落ちているコードをコピーしたら弄って作成しているのでコードのすべてを理解してるわけではありません。。。)

該当のソースコード

VBA

1Option Explicit 2Sub xml() 3 4 Dim DOMDoc As MSXML2.DOMDocument60 'XMLドキュメント 5 Dim DeclareNode As Variant 'XML宣言 6 Dim RootNode As Variant 'root要素(KKK) 7 Dim ParentNode01 As Variant '親要素(BBB) 8 Dim ChildNode01 As Variant '子要素(ID) 9 Dim ChildNode02 As Variant '子要素(TTT) 10 Dim ChildNode03 As Variant '子要素(SQL) 11 Dim ChildNode04 As Variant '子要素(保存ファイル名) 12 Dim ChildNode05 As Variant '子要素(項目) 13 Dim i As Integer 'iの定義 14 Dim attr01 As MSXML2.IXMLDOMAttribute '属性ノード 15 Dim changeBox As Variant 16 17 'XMLドキュメントを作成 18 Set DOMDoc = New MSXML2.DOMDocument60 19 20 DOMDoc.async = False 21 22 'XML宣言(文字コードにはUTF-8を指定) 23 Set DeclareNode = DOMDoc.appendChild(DOMDoc.createProcessingInstruction("xml", "version=""1.0"" encoding=""UTF-8""")) 24 25 '要素<KKK>を追加 26 Set RootNode = DOMDoc.appendChild(DOMDoc.createNode(NODE_ELEMENT, "KKK", "")) 27 28 For i = 1 To 150 29 30 ' IF文 BBB欄が空白ならnext iへ 31 If Not Cells(1 + i, 1) = "" Then 32 33 '親要素<BBB>を追加 34 Set ParentNode01 = RootNode.appendChild(DOMDoc.createNode(NODE_ELEMENT, "BBB", "")) 35 36 '属性ノード「type」の値を指定 37 Set attr01 = ParentNode01.Attributes.setNamedItem(DOMDoc.createNode(NODE_ATTRIBUTE, "type", "")) 38 attr01.NodeValue = Cells(1 + i, 2) 39 40 '子要素<ID>を追加 41 Set ChildNode01 = ParentNode01.appendChild(DOMDoc.createNode(NODE_ELEMENT, "ID", "")) 42 ChildNode01.text = Cells(1 + i, 1) 43 44 '子要素<TTT>を追加 45 Set ChildNode02 = ParentNode01.appendChild(DOMDoc.createNode(NODE_ELEMENT, "TTT", "")) 46 ChildNode02.text = Cells(1 + i, 3) 47 48 '子要素<SQL>を追加 49 Set ChildNode03 = ParentNode01.appendChild(DOMDoc.createNode(NODE_ELEMENT, "SQL", "")) 50 ChildNode03.text = Cells(1 + i, 5) 51 52 '子要素<保存ファイル名>を追加 53 Set ChildNode04 = ParentNode01.appendChild(DOMDoc.createNode(NODE_ELEMENT, "保存ファイル名", "")) 54 ChildNode04.text = Cells(1 + i, 4) 55 56 '子要素<項目>を追加 57 Set ChildNode05 = ParentNode01.appendChild(DOMDoc.createNode(NODE_ELEMENT, "項目", "")) 58 ChildNode05.text = Cells(1 + i, 6) 59 60 End If 61 ' iの定義ループ 62 Next i 63 64 DOMDoc.LoadXML indent(DOMDoc.xml) 65 66 ' XMLDOMオブジェクトのSaveメソッドにXMLファイルを出力 67 DOMDoc.Save "ファイルパス.xml" 68 69 ' XMLDOMオブジェクトを破棄 70 Set DOMDoc = Nothing 71 72 MsgBox "xmlファイル作成完了/オブジェクト破壊完了", vbInformation 73 74End Sub 75 76 77'出力するXMLファイルに改行とインデントを付与する。' 78 79Function indent(ByVal xml As String) As String 80 81 Dim writer As MSXML2.MXXMLWriter60 ' Writerの定義 82 Dim reader As MSXML2.SAXXMLReader60 ' Readerの定義 83 Dim dom As MSXML2.DOMDocument60 ' XMLドキュメント 84 Dim n As MSXML2.IXMLDOMNode ' n要素 85 86 ' XMLドキュメントを作成 87 Set writer = New MSXML2.MXXMLWriter60 88 89 ' xml宣言を書き込まない 90 writer.omitXMLDeclaration = True 91 92 ' インデントする 93 writer.indent = True 94 95 Set reader = New MSXML2.SAXXMLReader60 ' New Readerを作成 96 Set reader.contentHandler = writer ' ReaderとWriterを紐づける 97 reader.Parse xml 98 99 ' 元のxmlから、xml宣言候補を退避 100 Set dom = New MSXML2.DOMDocument60 101 dom.LoadXML xml 102 103 Set n = dom.ChildNodes(0) 104 105 ' インデントされたxmlを読み込む 106 ' 元のxmlにxml宣言があったとしても、除外されている 107 dom.LoadXML writer.output 108 109 ' 元のxmlにxml宣言があれば、インデントされたxmlに追加 110 If n.nodeName = "xml" And n.NodeType = NODE_PROCESSING_INSTRUCTION Then 111 dom.InsertBefore n, dom.ChildNodes(0) 112 113 End If 114 115 ' インデントされたxmlを返す 116 indent = dom.xml 117 118 Set writer = Nothing 119 End Function 120 121 122 123 124Sub 置換() 125 126 Dim targetFile As String 127 Dim beforeStr As String 128 Dim afterStr As String 129 Dim psCommand As String 130 Dim wsh As Object 131 Dim result As Integer 132 133  '置換前文字列 134 beforeStr = "<?xml version="1.0"?>" 135 '置換後文字列 136 afterStr = "<?xml version="1.0" encoding="UTF-8" standalone="yes"?>" 137 138 'PowerShellのコマンドレットを組み立て 139 psCommand = "powershell -NoProfile -ExecutionPolicy Unrestricted " 140 psCommand = psCommand & "(Get-Content " & targetFile & ") -creplace " & "'" & beforeStr & "'" & "," & "'" & afterStr & "'" 141 psCommand = psCommand & " | Out-File -Encoding default " & targetFile 142 143 Set wsh = CreateObject("WScript.Shell") 144 145 'PowerShellのコマンドレットを実行 146 result = wsh.Run(Command:=psCommand, WindowStyle:=0, WaitOnReturn:=True) 147 148 If (result = 0) Then 149 Else 150 End If 151 152 '後片付け 153 Set wsh = Nothing 154 155End Sub

コメントを投稿

0 コメント