├── .gitattributes ├── .gitignore ├── LICENSE ├── XMLConverter.bas ├── build └── dev.vbs ├── design.md ├── readme.md └── specs ├── Specs.bas └── VBA-XML - Specs.xlsm /.gitattributes: -------------------------------------------------------------------------------- 1 | # CRLF -> LF by default, but not for modules or classes (especially classes) 2 | * text=auto 3 | *.bas text eol=crlf 4 | *.cls text eol=crlf 5 | 6 | # Standard to msysgit 7 | *.doc diff=astextplain 8 | *.DOC diff=astextplain 9 | *.docx diff=astextplain 10 | *.DOCX diff=astextplain 11 | *.dot diff=astextplain 12 | *.DOT diff=astextplain 13 | *.pdf diff=astextplain 14 | *.PDF diff=astextplain 15 | *.rtf diff=astextplain 16 | *.RTF diff=astextplain 17 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Ignore temporary Excel files 2 | */~$* 3 | 4 | # Ignore scratch work and other files 5 | _scratch 6 | .DS_Store -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2016 Tim Hall 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /XMLConverter.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "XMLConverter" 2 | '' 3 | ' VBA-XML v0.0.0 4 | ' (c) Tim Hall - https://github.com/VBA-tools/VBA-XML 5 | ' 6 | ' XML Converter for VBA 7 | ' 8 | ' Design: 9 | ' The goal is to have the general form of MSXML2.DOMDocument (albeit not feature complete) 10 | ' 11 | ' ParseXML(AB) -> 12 | ' 13 | ' {Dictionary} 14 | ' - nodeName: {String} "#document" 15 | ' - attributes: {Collection} (Nothing) 16 | ' - childNodes: {Collection} 17 | ' {Dictionary} 18 | ' - nodeName: "messages" 19 | ' - attributes: (empty) 20 | ' - childNodes: 21 | ' {Dictionary} 22 | ' - nodeName: "message" 23 | ' - attributes: 24 | ' {Collection of Dictionary} 25 | ' nodeName: "id" 26 | ' text: "1" 27 | ' - childNodes: (empty) 28 | ' - text: A 29 | ' {Dictionary} 30 | ' - nodeName: "message" 31 | ' - attributes: 32 | ' {Collection of Dictionary} 33 | ' nodeName: "id" 34 | ' text: "2" 35 | ' - childNodes: (empty) 36 | ' - text: B 37 | ' 38 | ' Errors: 39 | ' 10101 - XML parse error 40 | ' 41 | ' References: 42 | ' - http://www.w3.org/TR/REC-xml/ 43 | ' 44 | ' @author: tim.hall.engr@gmail.com 45 | ' @license: MIT (http://www.opensource.org/licenses/mit-license.php 46 | ' 47 | ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 48 | 49 | #If Mac Then 50 | #ElseIf VBA7 Then 51 | 52 | Private Declare PtrSafe Sub json_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ 53 | (json_MemoryDestination As Any, json_MemorySource As Any, ByVal json_ByteLength As Long) 54 | 55 | #Else 56 | 57 | Private Declare Sub json_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ 58 | (json_MemoryDestination As Any, json_MemorySource As Any, ByVal json_ByteLength As Long) 59 | 60 | #End If 61 | 62 | Private Const xml_Html5VoidNodeNames As String = "area|base|br|col|command|embed|hr|img|input|keygen|link|meta|param|source|track|wbr" 63 | 64 | ' ============================================= ' 65 | ' Public Methods 66 | ' ============================================= ' 67 | 68 | '' 69 | ' Convert XML string to Dictionary 70 | ' 71 | ' @param {String} xml_String 72 | ' @return {Object} (Dictionary) 73 | ' -------------------------------------- ' 74 | Public Function ParseXml(ByVal xml_String As String) As Dictionary 75 | Dim xml_Index As Long 76 | xml_Index = 1 77 | 78 | ' Remove vbCr, vbLf, and vbTab from xml_String 79 | xml_String = VBA.Replace(VBA.Replace(VBA.Replace(xml_String, VBA.vbCr, ""), VBA.vbLf, ""), VBA.vbTab, "") 80 | 81 | xml_SkipSpaces xml_String, xml_Index 82 | If VBA.Mid$(xml_String, xml_Index, 1) <> "<" Then 83 | ' Error: Invalid XML string 84 | Err.Raise 10101, "XMLConverter", xml_ParseErrorMessage(xml_String, xml_Index, "Expecting '<'") 85 | Else 86 | Set ParseXml = New Dictionary 87 | ParseXml.Add "prolog", xml_ParseProlog(xml_String, xml_Index) 88 | ParseXml.Add "doctype", xml_ParseDoctype(xml_String, xml_Index) 89 | 90 | ParseXml.Add "nodeName", "#document" 91 | ParseXml.Add "attributes", Nothing 92 | 93 | Dim xml_ChildNodes As New Collection 94 | xml_ChildNodes.Add xml_ParseNode(ParseXml, xml_String, xml_Index) 95 | ParseXml.Add "childNodes", xml_ChildNodes 96 | End If 97 | End Function 98 | 99 | '' 100 | ' Convert Dictionary to XML 101 | ' 102 | ' @param {Dictionary} xml_Dictionary 103 | ' @return {String} 104 | ' -------------------------------------- ' 105 | Public Function ConvertToXML(ByVal xml_Dictionary As Dictionary) As String 106 | Dim xml_buffer As String 107 | Dim xml_BufferPosition As Long 108 | Dim xml_BufferLength As Long 109 | 110 | ' TODO 111 | End Function 112 | 113 | ' ============================================= ' 114 | ' Private Functions 115 | ' ============================================= ' 116 | 117 | Private Function xml_ParseProlog(xml_String As String, ByRef xml_Index As Long) As String 118 | Dim xml_OpeningLevel As Long 119 | Dim xml_StringLength As Long 120 | Dim xml_StartIndex As Long 121 | Dim xml_Chars As String 122 | 123 | xml_SkipSpaces xml_String, xml_Index 124 | If VBA.Mid$(xml_String, xml_Index, 2) = " 130 | Do 131 | xml_Chars = VBA.Mid$(xml_String, xml_Index, 2) 132 | 133 | If xml_Index + 1 > xml_StringLength Then 134 | Err.Raise 10101, "XMLConverter", xml_ParseErrorMessage(xml_String, xml_Index, "Expecting '?>'") 135 | ElseIf xml_OpeningLevel = 0 And xml_Chars = "?>" Then 136 | xml_Index = xml_Index + 2 137 | Exit Do 138 | ElseIf xml_Chars = "" Then 142 | xml_OpeningLevel = xml_OpeningLevel - 1 143 | xml_Index = xml_Index + 2 144 | Else 145 | xml_Index = xml_Index + 1 146 | End If 147 | Loop 148 | 149 | xml_ParseProlog = VBA.Mid$(xml_String, xml_StartIndex, xml_Index - xml_StartIndex) 150 | End If 151 | End Function 152 | 153 | Private Function xml_ParseDoctype(xml_String As String, ByRef xml_Index As Long) As String 154 | Dim xml_OpeningLevel As Long 155 | Dim xml_StringLength As Long 156 | Dim xml_StartIndex As Long 157 | Dim xml_Char As String 158 | 159 | xml_SkipSpaces xml_String, xml_Index 160 | If VBA.Mid$(xml_String, xml_Index, 2) = " 166 | Do 167 | xml_Char = VBA.Mid$(xml_String, xml_Index, 1) 168 | xml_Index = xml_Index + 1 169 | 170 | If xml_Index > xml_StringLength Then 171 | Err.Raise 10101, "XMLConverter", xml_ParseErrorMessage(xml_String, xml_Index, "Expecting '>'") 172 | ElseIf xml_OpeningLevel = 0 And xml_Char = ">" Then 173 | Exit Do 174 | ElseIf xml_Char = "<" Then 175 | xml_OpeningLevel = xml_OpeningLevel + 1 176 | ElseIf xml_Char = ">" Then 177 | xml_OpeningLevel = xml_OpeningLevel - 1 178 | End If 179 | Loop 180 | 181 | xml_ParseDoctype = VBA.Mid$(xml_String, xml_StartIndex, xml_Index - xml_StartIndex) 182 | End If 183 | End Function 184 | 185 | Private Function xml_ParseNode(xml_Parent As Dictionary, xml_String As String, ByRef xml_Index As Long) As Dictionary 186 | Dim xml_StartIndex As Long 187 | Dim xml_Char As String 188 | Dim xml_StringLength As Long 189 | 190 | xml_SkipSpaces xml_String, xml_Index 191 | If VBA.Mid$(xml_String, xml_Index, 1) <> "<" Then 192 | Err.Raise 10101, "XMLConverter", xml_ParseErrorMessage(xml_String, xml_Index, "Expecting '<'") 193 | Else 194 | ' Skip opening bracket 195 | xml_Index = xml_Index + 1 196 | 197 | ' Initialize node 198 | Set xml_ParseNode = New Dictionary 199 | xml_ParseNode.Add "parentNode", xml_Parent 200 | xml_ParseNode.Add "attributes", New Collection 201 | xml_ParseNode.Add "childNodes", New Collection 202 | xml_ParseNode.Add "text", "" 203 | xml_ParseNode.Add "firstChild", Nothing 204 | xml_ParseNode.Add "lastChild", Nothing 205 | 206 | ' 1. Parse nodeName 207 | xml_SkipSpaces xml_String, xml_Index 208 | xml_StartIndex = xml_Index 209 | xml_StringLength = Len(xml_String) 210 | 211 | Do 212 | xml_Char = VBA.Mid$(xml_String, xml_Index, 1) 213 | 214 | Select Case xml_Char 215 | Case " ", ">", "/" 216 | xml_ParseNode.Add "nodeName", VBA.Mid$(xml_String, xml_StartIndex, xml_Index - xml_StartIndex) 217 | 218 | ' Skip space 219 | If xml_Char = " " Then 220 | xml_Index = xml_Index + 1 221 | End If 222 | Exit Do 223 | Case Else 224 | xml_Index = xml_Index + 1 225 | End Select 226 | 227 | If xml_Index + 1 > xml_StringLength Then 228 | Err.Raise 10101, "XMLConverter", xml_ParseErrorMessage(xml_String, xml_Index, "Expecting ' ', '>', or '/>'") 229 | End If 230 | Loop 231 | 232 | ' If /> Exit Function 233 | If VBA.Mid$(xml_String, xml_Index, 2) = "/>" Then 234 | ' Skip over closing '/>' and exit 235 | xml_Index = xml_Index + 2 236 | Exit Function 237 | ElseIf VBA.Mid$(xml_String, xml_Index, 1) = ">" Then 238 | ' Skip over '>' 239 | xml_Index = xml_Index + 1 240 | Else 241 | ' 2. Parse attributes 242 | xml_ParseAttributes xml_ParseNode, xml_String, xml_Index 243 | End If 244 | 245 | ' If /> Exit Function 246 | If VBA.Mid$(xml_String, xml_Index, 2) = "/>" Then 247 | ' Skip over closing '/>' and exit 248 | xml_Index = xml_Index + 2 249 | Exit Function 250 | End If 251 | 252 | ' 3. Check against known void nodes 253 | If xml_IsVoidNode(xml_ParseNode) Then 254 | Exit Function 255 | End If 256 | 257 | ' 4. Parse childNodes 258 | xml_ParseChildNodes xml_ParseNode, xml_String, xml_Index 259 | End If 260 | End Function 261 | 262 | Private Function xml_ParseAttributes(ByRef xml_Node As Dictionary, xml_String As String, ByRef xml_Index As Long) As Collection 263 | Dim xml_Char As String 264 | Dim xml_StartIndex As Long 265 | Dim xml_StringLength As Long 266 | Dim xml_Quote As String 267 | Dim xml_Attributes As New Collection 268 | Dim xml_Attribute As Dictionary 269 | Dim xml_Name As String 270 | Dim xml_Value As String 271 | 272 | xml_SkipSpaces xml_String, xml_Index 273 | xml_StartIndex = xml_Index 274 | xml_StringLength = Len(xml_String) 275 | 276 | Do 277 | xml_Char = VBA.Mid$(xml_String, xml_Index, 1) 278 | 279 | Select Case xml_Char 280 | Case "=" 281 | ' Found end of attribute name 282 | ' Extract name, skip =, reset start index, and check for quote 283 | xml_Name = VBA.Mid$(xml_String, xml_StartIndex, xml_Index - xml_StartIndex) 284 | 285 | xml_Index = xml_Index + 1 286 | 287 | ' Check quote style of attribute value 288 | xml_Char = VBA.Mid$(xml_String, xml_Index, 1) 289 | If xml_Char = """" Or xml_Char = "'" Then 290 | xml_Quote = xml_Char 291 | xml_Index = xml_Index + 1 292 | End If 293 | 294 | xml_StartIndex = xml_Index 295 | Case xml_Quote, " ", ">", "/" 296 | If xml_Char = "/" And VBA.Mid$(xml_String, xml_Index, 2) <> "/>" Then 297 | ' It's just a simple escape 298 | xml_Index = xml_Index + 1 299 | Else 300 | If xml_Name <> "" Then 301 | ' Attribute name was stored, end of attribute value 302 | xml_Value = VBA.Mid$(xml_String, xml_StartIndex, xml_Index - xml_StartIndex) 303 | 304 | ' Store name, value 305 | Set xml_Attribute = New Dictionary 306 | xml_Attribute.Add "name", xml_Name 307 | xml_Attribute.Add "value", xml_Value 308 | xml_Attributes.Add xml_Attribute 309 | Else 310 | ' No name was stored, end of attribute name without value 311 | xml_Name = VBA.Mid$(xml_String, xml_StartIndex, xml_Index - xml_StartIndex) 312 | 313 | ' Stor ename 314 | Set xml_Attribute = New Dictionary 315 | xml_Attribute.Add "name", xml_Name 316 | ' TODO Set value to ""? 317 | xml_Attributes.Add xml_Attribute 318 | End If 319 | 320 | If xml_Char = ">" Or xml_Char = "/" Then 321 | Exit Do 322 | Else 323 | xml_Name = "" 324 | xml_Value = "" 325 | 326 | xml_Index = xml_Index + 1 327 | xml_SkipSpaces xml_String, xml_Index 328 | xml_StartIndex = xml_Index 329 | End If 330 | End If 331 | Case Else 332 | xml_Index = xml_Index + 1 333 | End Select 334 | 335 | If xml_Index > xml_StringLength Then 336 | Err.Raise 10101, "XMLConverter", xml_ParseErrorMessage(xml_String, xml_Index, "Expecting '>' or '/>'") 337 | End If 338 | Loop 339 | 340 | Set xml_Node("attributes") = xml_Attributes 341 | End Function 342 | 343 | Private Function xml_ParseChildNodes(ByRef xml_Node As Dictionary, xml_String As String, ByRef xml_Index As Long) As Collection 344 | ' TODO Set childNodes, text, and other properties on xml_Node 345 | End Function 346 | 347 | Private Function xml_IsVoidNode(xml_Node As Dictionary) As Boolean 348 | ' xml_HTML5VoidNodeNames 349 | ' TODO xml_VoidNode = Check doctype for html: xml_RootNode("doctype")... 350 | End Function 351 | 352 | Private Function xml_ProcessString(xml_String As String) As String 353 | Dim xml_buffer As String 354 | Dim xml_BufferPosition As Long 355 | Dim xml_BufferLength As Long 356 | Dim xml_Index As Long 357 | 358 | ' TODO 359 | xml_BufferAppend xml_buffer, xml_String, xml_BufferPosition, xml_BufferLength 360 | xml_ProcessString = xml_BufferToString(xml_buffer, xml_BufferPosition, xml_BufferLength) 361 | End Function 362 | 363 | Private Function xml_RootNode(xml_Node As Dictionary) As Dictionary 364 | Set xml_RootNode = xml_Node 365 | Do While Not xml_RootNode.Exists("parentNode") 366 | Set xml_RootNode = xml_RootNode("parentNode") 367 | Loop 368 | End Function 369 | 370 | Private Sub xml_SkipSpaces(xml_String As String, ByRef xml_Index As Long) 371 | ' Increment index to skip over spaces 372 | Do While xml_Index > 0 And xml_Index <= VBA.Len(xml_String) And VBA.Mid$(xml_String, xml_Index, 1) = " " 373 | xml_Index = xml_Index + 1 374 | Loop 375 | End Sub 376 | 377 | Private Function xml_StringIsLargeNumber(xml_String As Variant) As Boolean 378 | ' Check if the given string is considered a "large number" 379 | ' (See xml_ParseNumber) 380 | 381 | Dim xml_Length As Long 382 | xml_Length = VBA.Len(xml_String) 383 | 384 | ' Length with be at least 16 characters and assume will be less than 100 characters 385 | If xml_Length >= 16 And xml_Length <= 100 Then 386 | Dim xml_CharCode As String 387 | Dim xml_Index As Long 388 | 389 | xml_StringIsLargeNumber = True 390 | 391 | For i = 1 To xml_Length 392 | xml_CharCode = VBA.Asc(VBA.Mid$(xml_String, i, 1)) 393 | Select Case xml_CharCode 394 | ' Look for .|0-9|E|e 395 | Case 46, 48 To 57, 69, 101 396 | ' Continue through characters 397 | Case Else 398 | xml_StringIsLargeNumber = False 399 | Exit Function 400 | End Select 401 | Next i 402 | End If 403 | End Function 404 | 405 | Private Function xml_ParseErrorMessage(xml_String As String, ByRef xml_Index As Long, xml_ErrorMessage As String) 406 | ' Provide detailed parse error message, including details of where and what occurred 407 | ' 408 | ' Example: 409 | ' Error parsing XML: 410 | ' 1234 411 | ' ^ 412 | ' Expecting '' 413 | 414 | Dim xml_StartIndex As Long 415 | Dim xml_StopIndex As Long 416 | 417 | ' Include 10 characters before and after error (if possible) 418 | xml_StartIndex = xml_Index - 10 419 | xml_StopIndex = xml_Index + 10 420 | If xml_StartIndex <= 0 Then 421 | xml_StartIndex = 1 422 | End If 423 | If xml_StopIndex > VBA.Len(xml_String) Then 424 | xml_StopIndex = VBA.Len(xml_String) 425 | End If 426 | 427 | xml_ParseErrorMessage = "Error parsing XML:" & VBA.vbNewLine & _ 428 | VBA.Mid$(xml_String, xml_StartIndex, xml_StopIndex - xml_StartIndex + 1) & VBA.vbNewLine & _ 429 | VBA.Space$(xml_Index - xml_StartIndex) & "^" & VBA.vbNewLine & _ 430 | xml_ErrorMessage 431 | End Function 432 | 433 | Private Sub xml_BufferAppend(ByRef xml_buffer As String, _ 434 | ByRef xml_Append As Variant, _ 435 | ByRef xml_BufferPosition As Long, _ 436 | ByRef xml_BufferLength As Long) 437 | 438 | #If Mac Then 439 | xml_buffer = xml_buffer & xml_Append 440 | #Else 441 | ' VBA can be slow to append strings due to allocating a new string for each append 442 | ' Instead of using the traditional append, allocate a large empty string and then copy string at append position 443 | ' 444 | ' Example: 445 | ' Buffer: "abc " 446 | ' Append: "def" 447 | ' Buffer Position: 3 448 | ' Buffer Length: 5 449 | ' 450 | ' Buffer position + Append length > Buffer length -> Append chunk of blank space to buffer 451 | ' Buffer: "abc " 452 | ' Buffer Length: 10 453 | ' 454 | ' Copy memory for "def" into buffer at position 3 (0-based) 455 | ' Buffer: "abcdef " 456 | ' 457 | ' Approach based on cStringBuilder from vbAccelerator 458 | ' http://www.vbaccelerator.com/home/VB/Code/Techniques/RunTime_Debug_Tracing/VB6_Tracer_Utility_zip_cStringBuilder_cls.asp 459 | 460 | Dim xml_AppendLength As Long 461 | Dim xml_LengthPlusPosition As Long 462 | 463 | xml_AppendLength = VBA.LenB(xml_Append) 464 | xml_LengthPlusPosition = xml_AppendLength + xml_BufferPosition 465 | 466 | If xml_LengthPlusPosition > xml_BufferLength Then 467 | ' Appending would overflow buffer, add chunks until buffer is long enough 468 | Dim xml_TemporaryLength As Long 469 | 470 | xml_TemporaryLength = xml_BufferLength 471 | Do While xml_TemporaryLength < xml_LengthPlusPosition 472 | ' Initially, initialize string with 255 characters, 473 | ' then add large chunks (8192) after that 474 | ' 475 | ' Size: # Characters x 2 bytes / character 476 | If xml_TemporaryLength = 0 Then 477 | xml_TemporaryLength = xml_TemporaryLength + 510 478 | Else 479 | xml_TemporaryLength = xml_TemporaryLength + 16384 480 | End If 481 | Loop 482 | 483 | xml_buffer = xml_buffer & VBA.Space$((xml_TemporaryLength - xml_BufferLength) \ 2) 484 | xml_BufferLength = xml_TemporaryLength 485 | End If 486 | 487 | ' Copy memory from append to buffer at buffer position 488 | xml_CopyMemory ByVal xml_UnsignedAdd(StrPtr(xml_buffer), _ 489 | xml_BufferPosition), _ 490 | ByVal StrPtr(xml_Append), _ 491 | xml_AppendLength 492 | 493 | xml_BufferPosition = xml_BufferPosition + xml_AppendLength 494 | #End If 495 | End Sub 496 | 497 | Private Function xml_BufferToString(ByRef xml_buffer As String, ByVal xml_BufferPosition As Long, ByVal xml_BufferLength As Long) As String 498 | #If Mac Then 499 | xml_BufferToString = xml_buffer 500 | #Else 501 | If xml_BufferPosition > 0 Then 502 | xml_BufferToString = VBA.Left$(xml_buffer, xml_BufferPosition \ 2) 503 | End If 504 | #End If 505 | End Function 506 | 507 | #If VBA7 Then 508 | Private Function xml_UnsignedAdd(xml_Start As LongPtr, xml_Increment As Long) As LongPtr 509 | #Else 510 | Private Function xml_UnsignedAdd(xml_Start As Long, xml_Increment As Long) As Long 511 | #End If 512 | 513 | If xml_Start And &H80000000 Then 514 | xml_UnsignedAdd = xml_Start + xml_Increment 515 | ElseIf (xml_Start Or &H80000000) < -xml_Increment Then 516 | xml_UnsignedAdd = xml_Start + xml_Increment 517 | Else 518 | xml_UnsignedAdd = (xml_Start + &H80000000) + (xml_Increment + &H80000000) 519 | End If 520 | End Function 521 | -------------------------------------------------------------------------------- /build/dev.vbs: -------------------------------------------------------------------------------- 1 | '' 2 | ' Dev 3 | ' (c) Tim Hall - https://github.com/timhall/VBA-XMLConverter 4 | ' 5 | ' Development steps for VBA-XMLConverter 6 | ' Run: cscript build/dev.vbs 7 | ' 8 | ' @author: tim.hall.engr@gmail.com 9 | ' @license: MIT (http://www.opensource.org/licenses/mit-license.php) 10 | ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 11 | Option Explicit 12 | 13 | Dim Args 14 | Set Args = WScript.Arguments 15 | 16 | Dim FSO 17 | Set FSO = CreateObject("Scripting.FileSystemObject") 18 | 19 | Dim Excel 20 | Dim ExcelWasOpen 21 | Set Excel = Nothing 22 | Dim Workbook 23 | Dim WorkbookWasOpen 24 | Set Workbook = Nothing 25 | 26 | Dim SrcFolder 27 | Dim SpecsFolder 28 | SrcFolder = ".\" 29 | SpecsFolder = ".\specs\" 30 | 31 | Dim SpecsWorkbookPath 32 | SpecsWorkbookPath = ".\specs\VBA-XMLConverter - Specs.xlsm" 33 | 34 | Dim Src 35 | Src = Array( _ 36 | "XMLConverter.bas" _ 37 | ) 38 | 39 | Dim Specs 40 | Specs = Array( _ 41 | "Specs.bas" _ 42 | ) 43 | 44 | Main 45 | 46 | Sub Main() 47 | ' On Error Resume Next 48 | 49 | PrintLn "VBA-XMLConverter v0.0.0 Development" 50 | 51 | ExcelWasOpen = OpenExcel(Excel) 52 | 53 | If Not Excel Is Nothing Then 54 | Development 55 | 56 | CloseExcel Excel, ExcelWasOpen 57 | ElseIf Err.Number <> 0 Then 58 | PrintLn vbNewLine & "ERROR: Failed to open Excel" & vbNewLIne & Err.Description 59 | End If 60 | 61 | Input vbNewLIne & "Done! Press any key to exit..." 62 | End Sub 63 | 64 | Sub Development 65 | PrintLn vbNewLine & _ 66 | "Options:" & vbNewLine & _ 67 | "- import [src/specs/all] to [specs/path...]" & vbNewLine & _ 68 | "- export [src/specs/all] from [specs/path...]" & vbNewLine & _ 69 | "- release" 70 | 71 | Dim Action 72 | Action = Input(vbNewLine & "What would you like to do? <") 73 | 74 | If Action = "" Then 75 | Exit Sub 76 | End If 77 | 78 | Dim Parts 79 | Parts = Split(Action, " ") 80 | 81 | ' Dim PartIndex 82 | ' For PartIndex = LBound(Parts) To UBound(Parts) 83 | ' PrintLn "Parts: " & PartIndex & ", " & Parts(PartIndex) 84 | ' Next 85 | 86 | If UCase(Parts(0)) = "RELEASE" Then 87 | Execute "import", "all", "specs" 88 | ElseIf UBound(Parts) < 3 Or (UCase(Parts(0)) <> "IMPORT" And UCase(Parts(0)) <> "EXPORT") Then 89 | PrintLn vbNewLine & "Error: Unrecognized action" 90 | Else 91 | If UBound(Parts) > 3 Then 92 | ' Combine path (in case there were spaces in name) and remove quotes 93 | Dim CustomPath 94 | Dim i 95 | For i = 3 To UBound(Parts) 96 | If CustomPath = "" Then 97 | CustomPath = Parts(i) 98 | Else 99 | CustomPath = CustomPath & " " & Parts(i) 100 | End If 101 | Next 102 | CustomPath = Replace(CustomPath, """", "") 103 | 104 | Execute Parts(0), Parts(1), CustomPath 105 | Else 106 | Execute Parts(0), Parts(1), Parts(3) 107 | End If 108 | End If 109 | 110 | PrintLn "" 111 | Development 112 | End Sub 113 | 114 | Sub Execute(Name, ModulesDescription, WorkbookDescription) 115 | ' PrintLn "Execute: " & Name & ", " & ModulesDescription & ", " & WorkbookDescription 116 | 117 | Dim Paths 118 | Select Case UCase(WorkbookDescription) 119 | Case "SPECS" 120 | Paths = Array(SpecsWorkbookPath) 121 | Case Else 122 | Paths = Array(WorkbookDescription) 123 | End Select 124 | 125 | Dim i 126 | For i = LBound(Paths) To UBound(Paths) 127 | ' PrintLn "Open: " & FullPath(Paths(i)) 128 | WorkbookWasOpen = OpenWorkbook(Excel, FullPath(Paths(i)), Workbook) 129 | 130 | If Not Workbook Is Nothing Then 131 | If Not VBAIsTrusted(Workbook) Then 132 | PrintLn vbNewLine & _ 133 | "ERROR: In order to install Excel-REST," & vbNewLine & _ 134 | "access to the VBA project object model needs to be trusted in Excel." & vbNewLine & vbNewLine & _ 135 | "To enable:" & vbNewLine & _ 136 | "Options > Trust Center > Trust Center Settings > Macro Settings > " & vbnewLine & _ 137 | "Trust access to the VBA project object model" 138 | Else 139 | If UCase(Name) = "IMPORT" Then 140 | Import ModulesDescription, Workbook 141 | ElseIf UCase(Name) = "EXPORT" Then 142 | Export ModulesDescription, Workbook 143 | End IF 144 | End If 145 | 146 | CloseWorkbook Workbook, WorkbookWasOpen 147 | ElseIf Err.Number <> 0 Then 148 | PrintLn vbNewLine & "ERROR: Failed to open Workbook" & vbNewLine & Err.Description 149 | Err.Clear 150 | End If 151 | Next 152 | End Sub 153 | 154 | Sub Import(ModulesDescription, Workbook) 155 | Dim Modules 156 | Dim Folder 157 | 158 | Select Case UCase(ModulesDescription) 159 | Case "SRC" 160 | Modules = Src 161 | Folder = SrcFolder 162 | Case "SPECS" 163 | Modules = Specs 164 | Folder = SpecsFolder 165 | Case "ALL" 166 | Import "src", Workbook 167 | Import "specs", Workbook 168 | Exit Sub 169 | Case Else 170 | PrintLn "ERROR: Unknown modules description, " & ModulesDescription 171 | Exit Sub 172 | End Select 173 | 174 | Print vbNewLine & "Importing " & ModulesDescription & " to " & Workbook.Name 175 | 176 | Dim i 177 | For i = LBound(Modules) To UBound(Modules) 178 | ImportModule Workbook, Folder, Modules(i) 179 | Print "." 180 | Next 181 | 182 | Print "Done!" 183 | End Sub 184 | 185 | Sub Export(ModulesDescription, Workbook) 186 | Dim Modules 187 | Dim Folder 188 | 189 | Select Case UCase(ModulesDescription) 190 | Case "SRC" 191 | Modules = Src 192 | Folder = SrcFolder 193 | Case "SPECS" 194 | Modules = Specs 195 | Folder = SpecsFolder 196 | Case "ALL" 197 | Export "src", Workbook 198 | Export "specs", Workbook 199 | Exit Sub 200 | Case Else 201 | PrintLn "ERROR: Unknown modules description, " & ModulesDescription 202 | Exit Sub 203 | End Select 204 | 205 | Print vbNewLine & "Exporting " & ModulesDescription & " from " & Workbook.Name 206 | 207 | Dim i 208 | Dim Module 209 | For i = LBound(Modules) To UBound(Modules) 210 | Set Module = GetModule(Workbook, RemoveExtension(Modules(i))) 211 | 212 | If Not Module Is Nothing Then 213 | Module.Export FullPath(Folder & Modules(i)) 214 | Print "." 215 | End If 216 | Next 217 | 218 | Print "Done!" 219 | End Sub 220 | 221 | '' 222 | ' Excel helpers 223 | ' ------------------------------------ ' 224 | 225 | '' 226 | ' Open Workbook and return whether Workbook was already open 227 | ' 228 | ' @param {Object} Excel 229 | ' @param {String} Path 230 | ' @param {Object} Workbook object to load Workbook into 231 | ' @return {Boolean} Workbook was already open 232 | Function OpenWorkbook(Excel, Path, ByRef Workbook) 233 | On Error Resume Next 234 | 235 | Path = FullPath(Path) 236 | Set Workbook = Excel.Workbooks(GetFilename(Path)) 237 | 238 | If Workbook Is Nothing Or Err.Number <> 0 Then 239 | Err.Clear 240 | 241 | If FileExists(Path) Then 242 | Set Workbook = Excel.Workbooks.Open(Path) 243 | Else 244 | Path = Input(vbNewLine & _ 245 | "Workbook not found at " & Path & vbNewLine & _ 246 | "Would you like to try another location? [path.../cancel] <") 247 | 248 | If UCase(Path) <> "CANCEL" And Path <> "" Then 249 | OpenWorkbook = OpenWorkbook(Excel, Path, Workbook) 250 | End If 251 | End If 252 | OpenWorkbook = False 253 | Else 254 | OpenWorkbook = True 255 | End If 256 | End Function 257 | 258 | '' 259 | ' Close Workbook and save changes 260 | ' (keep open without saving changes if previously open) 261 | ' 262 | ' @param {Object} Workbook 263 | ' @param {Boolean} KeepWorkbookOpen 264 | Sub CloseWorkbook(ByRef Workbook, KeepWorkbookOpen) 265 | If Not KeepWorkbookOpen And Not Workbook Is Nothing Then 266 | Workbook.Close True 267 | End If 268 | 269 | Set Workbook = Nothing 270 | End Sub 271 | 272 | '' 273 | ' Open Excel and return whether Excel was already open 274 | ' 275 | ' @param {Object} Excel object to load Excel into 276 | ' @return {Boolean} Excel was already open 277 | Function OpenExcel(ByRef Excel) 278 | On Error Resume Next 279 | 280 | Set Excel = GetObject(, "Excel.Application") 281 | 282 | If Excel Is Nothing Or Err.Number <> 0 Then 283 | Err.Clear 284 | 285 | Set Excel = CreateObject("Excel.Application") 286 | OpenExcel = False 287 | Else 288 | OpenExcel = True 289 | End If 290 | End Function 291 | 292 | '' 293 | ' Close Excel (keep open if previously open) 294 | ' 295 | ' @param {Object} Excel 296 | ' @param {Boolean} KeepExcelOpen 297 | Sub CloseExcel(ByRef Excel, KeepExcelOpen) 298 | If Not KeepExcelOpen And Not Excel Is Nothing Then 299 | Excel.Quit 300 | End If 301 | 302 | Set Excel = Nothing 303 | End Sub 304 | 305 | '' 306 | ' Check if VBA is trusted 307 | ' 308 | ' @param {Object} Workbook 309 | ' @param {Boolean} 310 | Function VBAIsTrusted(Workbook) 311 | On Error Resume Next 312 | Dim Count 313 | Count = Workbook.VBProject.VBComponents.Count 314 | 315 | If Err.Number <> 0 Then 316 | Err.Clear 317 | VBAIsTrusted = False 318 | Else 319 | VBAIsTrusted = True 320 | End If 321 | End Function 322 | 323 | '' 324 | ' Get module 325 | ' 326 | ' @param {Object} Workbook 327 | ' @param {String} Name 328 | Function GetModule(Workbook, Name) 329 | Dim Module 330 | Set GetModule = Nothing 331 | 332 | For Each Module In Workbook.VBProject.VBComponents 333 | If Module.Name = Name Then 334 | Set GetModule = Module 335 | Exit Function 336 | End If 337 | Next 338 | End Function 339 | 340 | '' 341 | ' Import module 342 | ' 343 | ' @param {Object} Workbook 344 | ' @param {String} Folder 345 | ' @param {String} Filename 346 | Sub ImportModule(Workbook, Folder, Filename) 347 | Dim Module 348 | If Not Workbook Is Nothing Then 349 | ' Check for existing and remove 350 | Set Module = GetModule(Workbook, RemoveExtension(Filename)) 351 | If Not Module Is Nothing Then 352 | Workbook.VBProject.VBComponents.Remove Module 353 | End If 354 | 355 | ' Import module 356 | Workbook.VBProject.VBComponents.Import FullPath(Folder & Filename) 357 | End If 358 | End Sub 359 | 360 | '' 361 | ' Get module and backup (if found) 362 | ' 363 | ' @param {Object} Workbook 364 | ' @param {String} Name 365 | ' @param {String} Prefix 366 | Function BackupModule(Workbook, Name, Prefix) 367 | Dim Backup 368 | Dim Existing 369 | Set Backup = GetModule(Workbook, Name) 370 | 371 | If Not Backup Is Nothing Then 372 | ' Remove any previous backups 373 | Set Existing = GetModule(Workbook, Prefix & Name) 374 | If Not Existing Is Nothing Then 375 | Workbook.VBProject.VBComponents.Remove Existing 376 | End If 377 | 378 | Backup.Name = Prefix & Name 379 | End If 380 | 381 | Set BackupModule = Backup 382 | End Function 383 | 384 | '' 385 | ' Restore module from backup (if found) 386 | ' 387 | ' @param {Object} Workbook 388 | ' @param {String} Name 389 | ' @param {String} Prefix 390 | Sub RestoreModule(Workbook, Name, Prefix) 391 | Dim Backup 392 | Dim Module 393 | Set Backup = GetModule(Workbook, Prefix & Name) 394 | 395 | If Not Backup Is Nothing Then 396 | ' Find upgraded module (and remove if found) 397 | Set Module = GetModule(Workbook, Name) 398 | If Not Module Is Nothing Then 399 | Workbook.VBProject.VBComponents.Remove Module 400 | End If 401 | 402 | ' Restore backup 403 | Backup.Name = Name 404 | End If 405 | End Sub 406 | 407 | '' 408 | ' Filesystem helpers 409 | ' ------------------------------------ ' 410 | 411 | Function FullPath(Path) 412 | FullPath = FSO.GetAbsolutePathName(Path) 413 | End Function 414 | 415 | Function GetFilename(Path) 416 | Dim Parts 417 | Parts = Split(Path, "\") 418 | 419 | GetFilename = Parts(UBound(Parts)) 420 | End Function 421 | 422 | Function RemoveExtension(Name) 423 | Dim Parts 424 | Parts = Split(Name, ".") 425 | 426 | If UBound(Parts) > LBound(Parts) Then 427 | ReDim Preserve Parts(UBound(Parts) - 1) 428 | End If 429 | 430 | RemoveExtension = Join(Parts, ".") 431 | End Function 432 | 433 | Function FileExists(Path) 434 | FileExists = FSO.FileExists(Path) 435 | End Function 436 | 437 | '' 438 | ' General helpers 439 | ' ------------------------------------ ' 440 | 441 | Sub Print(Message) 442 | WScript.StdOut.Write Message 443 | End Sub 444 | 445 | Sub PrintLn(Message) 446 | Wscript.Echo Message 447 | End Sub 448 | 449 | Function Input(Prompt) 450 | If Prompt <> "" Then 451 | Print Prompt & " " 452 | End If 453 | 454 | Input = WScript.StdIn.ReadLine 455 | End Function 456 | -------------------------------------------------------------------------------- /design.md: -------------------------------------------------------------------------------- 1 | # Goals 2 | 3 | - Generally match `MSXML2.DOMDocument` 4 | - Utilize `Dictionary` and `Collection` to add no new classes 5 | - Xml = ConvertToXml(ParseXml(Xml)) 6 | 7 | # Parsing Components 8 | 9 | 1. prolog: `` 10 | 2. doctype: `` 11 | 3. documentElement: Root element 12 | 4. Element: 13 | 14 | ``` 15 | #document (Element) 16 | prolog: (Element) 17 | doctype: (Element) 18 | documentElement: (Element) 19 | nodeName: "#document" 20 | childNodes: 21 | - (prolog) 22 | - (doctype) 23 | - (documentElement) 24 | attributes: (empty) 25 | text: "" 26 | xml: "..." 27 | ``` 28 | 29 | # Element 30 | 31 | - nodeName `String` 32 | - childNodes `Collection` 33 | - attributes `Dictionary` 34 | - text `String` 35 | - xml `String` 36 | 37 | ```html 38 | AB 39 | ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ 40 | a b c d e f g h i j 41 | ``` 42 | 43 | `parseElement` 44 | 45 | - a: `<`, nodeName = "messages" 46 | - b: `non->`, attribute, key = "name" 47 | - c: `=`, value = "Tim" 48 | - d: `>`, close opening tag, check for childNodes/text/void next 49 | - e: `< + non-/`, opening tag, childNodes + parseElement 50 | - f: `non-<`, text = "A" 51 | - g: ` and exit parseElement 52 | - h: `< + non-/`, another opening tag, childNodes + parseElement 53 | - i: ` and exit parseElement 54 | - j: ` and exit original parseElement 55 | 56 | ``` 57 | Look for space -> attributes 58 | Look for > -> end of opening 59 | 60 | If void element, look for immediate or < 61 | Otherwise: 62 | Look for immediate < -> childNodes -> parseElement 63 | Look for ... -> text 64 | Look for immediate close element 65 | ``` 66 | 67 | TODO Handle comments 68 | 69 | `parseAttribute -> Array(Key, Value)` 70 | 71 | `createElement(nodeName, childNodes, attributes, text, xml) -> Dictionary` 72 | 73 | Helper for loading values into `Dictionary` 74 | 75 | # Process 76 | 77 | 1. Parse prolog into Element 78 | 2. Parse doctype into Element 79 | 3. Use `parseElement` starting after doctype for documentElement 80 | 4. Create #document element and add prolog, doctype, and documentElement 81 | -------------------------------------------------------------------------------- /readme.md: -------------------------------------------------------------------------------- 1 | # VBA-XMLConverter 2 | 3 | __Status__: _Incomplete, Under Development_ 4 | 5 | XML conversion and parsing for VBA (Excel, Access, and other Office applications). 6 | 7 | Tested in Windows Excel 2013 and Excel for Mac 2011, but should apply to 2007+. 8 | 9 | - For Windows-only support, include a reference to "Microsoft Scripting Runtime" 10 | - For Mac support or to skip adding a reference, include [VBA-Dictionary](https://github.com/timhall/VBA-Dictionary). 11 | 12 | # Example 13 | 14 | ```VB.net 15 | Dim XML As Object 16 | Set XML = XMLConverter.ParseXML( _ 17 | "" & _ 18 | "" & _ 19 | "" & _ 20 | "Tim Hall" & _ 21 | "Howdy!" & _ 22 | "" & _ 23 | "" _ 24 | ) 25 | 26 | Debug.Print XML("documentElement")("nodeName") ' -> "messages" 27 | Debug.Print XML("documentElement")("childNodes")(1)("attributes")("id") ' -> "1" 28 | Debug.Print XML("documentElement")("childNodes")(1)("childNodes")(2)("text") ' -> "Howdy!" 29 | 30 | Debug.Print XMLConverter.ConvertToXML(XML) 31 | ' -> "..." 32 | ``` 33 | -------------------------------------------------------------------------------- /specs/Specs.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "Specs" 2 | Public Function Specs() As SpecSuite 3 | Set Specs = New SpecSuite 4 | Specs.Description = "VBA-XmlConverter" 5 | 6 | On Error Resume Next 7 | 8 | Dim XmlString As String 9 | Dim XmlObject As Dictionary 10 | Dim Document As New DOMDocument 11 | Document.async = False 12 | 13 | ' ============================================= ' 14 | ' ParseXml 15 | ' ============================================= ' 16 | 17 | With Specs.It("should parse prolog") 18 | XmlString = "]>Howdy!" 19 | Set XmlObject = XMLConverter.ParseXml(XmlString) 20 | 21 | .Expect(XmlObject("prolog")).ToEqual "" 22 | End With 23 | 24 | With Specs.It("should parse doctype") 25 | XmlString = "]>Howdy!" 26 | Set XmlObject = XMLConverter.ParseXml(XmlString) 27 | 28 | Document.LoadXML XmlString 29 | 30 | .Expect(XmlObject("doctype")("xml")).ToEqual "]>" 31 | End With 32 | 33 | With Specs.It("should parse simple element") 34 | XmlString = "Howdy!Howdy 2!" 35 | Set XmlObject = XMLConverter.ParseXml(XmlString) 36 | 37 | Document.LoadXML XmlString 38 | 39 | .Expect(Document.nodeName).ToEqual "#document" 40 | .Expect(Document.documentElement.nodeName).ToEqual "messages" 41 | .Expect(Document.documentElement.childNodes.Length).ToEqual 2 42 | .Expect(Document.documentElement.childNodes(0).nodeName).ToEqual "message" 43 | .Expect(Document.documentElement.childNodes(0).text).ToEqual "Howdy!" 44 | .Expect(Document.documentElement.childNodes(0).attributes(0).nodeName).ToEqual "id" 45 | .Expect(Document.documentElement.childNodes(0).attributes(0).text).ToEqual "1" 46 | .Expect(Document.documentElement.childNodes(1).nodeName).ToEqual "message" 47 | .Expect(Document.documentElement.childNodes(1).text).ToEqual "Howdy 2!" 48 | .Expect(Document.documentElement.childNodes(1).attributes(0).nodeName).ToEqual "id" 49 | .Expect(Document.documentElement.childNodes(1).attributes(0).text).ToEqual "2" 50 | 51 | .Expect(XmlObject("nodeName")).ToEqual "#document" 52 | .Expect(XmlObject("childNodes").Count).ToEqual 1 53 | .Expect(XmlObject("documentElement")("nodeName")).ToEqual "messages" 54 | .Expect(XmlObject("documentElement")("childNodes").Count).ToEqual 2 55 | .Expect(XmlObject("documentElement")("childNodes")(1)("nodeName")).ToEqual "message" 56 | .Expect(XmlObject("documentElement")("childNodes")(1)("text")).ToEqual "Howdy!" 57 | .Expect(XmlObject("documentElement")("childNodes")(1)("attributes")(1)("name")).ToEqual "id" 58 | .Expect(XmlObject("documentElement")("childNodes")(1)("attributes")(1)("value")).ToEqual "1" 59 | .Expect(XmlObject("documentElement")("childNodes")(2)("nodeName")).ToEqual "message" 60 | .Expect(XmlObject("documentElement")("childNodes")(2)("text")).ToEqual "Howdy 2!" 61 | .Expect(XmlObject("documentElement")("childNodes")(2)("attributes")(2)("name")).ToEqual "id" 62 | .Expect(XmlObject("documentElement")("childNodes")(2)("attributes")(2)("value")).ToEqual "2" 63 | End With 64 | 65 | With Specs.It("should parse advanced XML") 66 | XmlString = "" & _ 67 | "" & vbNewLine & _ 71 | " " & vbNewLine & _ 72 | " " & vbNewLine & _ 73 | " " & vbNewLine & _ 74 | " Tim" & vbNewLine & _ 75 | " " & vbNewLine & "Howdy!" & vbNewLine & "" & vbNewLine & _ 76 | " " & vbNewLine & _ 77 | " " & vbNewLine & _ 78 | " Tim" & vbNewLine & _ 79 | " " & vbNewLine & "Howdy again!" & vbNewLine & "" & vbNewLine & _ 80 | " " & vbNewLine & _ 81 | " " & vbNewLine & _ 82 | "" 83 | End With 84 | 85 | ' ============================================= ' 86 | ' ConvertToXml 87 | ' ============================================= ' 88 | 89 | 90 | 91 | ' ============================================= ' 92 | ' Errors 93 | ' ============================================= ' 94 | 95 | 96 | 97 | InlineRunner.RunSuite Specs 98 | End Function 99 | 100 | Public Sub RunSpecs() 101 | DisplayRunner.IdCol = 1 102 | DisplayRunner.DescCol = 1 103 | DisplayRunner.ResultCol = 2 104 | DisplayRunner.OutputStartRow = 4 105 | 106 | DisplayRunner.RunSuite Specs 107 | End Sub 108 | 109 | Public Function ToMatchParseError(Actual As Variant, Args As Variant) As Variant 110 | Dim Partial As String 111 | Dim Arrow As String 112 | Dim Message As String 113 | Dim Description As String 114 | 115 | If UBound(Args) < 2 Then 116 | ToMatchParseError = "Need to pass expected partial, arrow, and message" 117 | ElseIf Err.Number = 10101 Then 118 | Partial = Args(0) 119 | Arrow = Args(1) 120 | Message = Args(2) 121 | Description = "Error parsing XML:" & vbNewLine & Partial & vbNewLine & Arrow & vbNewLine & Message 122 | 123 | Dim Parts As Variant 124 | Parts = Split(Err.Description, vbNewLine) 125 | 126 | If Parts(1) <> Partial Then 127 | ToMatchParseError = "Expected " & Parts(1) & " to equal " & Partial 128 | ElseIf Parts(2) <> Arrow Then 129 | ToMatchParseError = "Expected " & Parts(2) & " to equal " & Arrow 130 | ElseIf Parts(3) <> Message Then 131 | ToMatchParseError = "Expected " & Parts(3) & " to equal " & Message 132 | ElseIf Err.Description <> Description Then 133 | ToMatchParseError = "Expected " & Err.Description & " to equal " & Description 134 | Else 135 | ToMatchParseError = True 136 | End If 137 | Else 138 | ToMatchParseError = "Expected error number " & Err.Number & " to be 10101" 139 | End If 140 | End Function 141 | -------------------------------------------------------------------------------- /specs/VBA-XML - Specs.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VBA-tools/VBA-XML/8469e32c6740215b4d74777ec03eca82861bf3e4/specs/VBA-XML - Specs.xlsm --------------------------------------------------------------------------------