[英]YAML Parser for Excel VBA
I have some YAML files and I need to populate those data in Excel using MS Excel Macros.我有一些 YAML 文件,我需要使用 MS Excel 宏在 Excel 中填充这些数据。 I am able to read YAML files and try to read line by line and find the semantics.我能够读取 YAML 文件并尝试逐行读取并找到语义。 But the process is getting more and more complex.但这个过程越来越复杂。 I am looking for an alternative solution.我正在寻找替代解决方案。
Is there a YAML Parser for Excel VBA?是否有用于 Excel VBA 的 YAML 解析器? If so, can you suggest few?如果是这样,你能推荐几个吗? I need this YAML in a Hash of Hash format, so that I can access the YAML data in hash of Hash format?我需要这个 Hash of Hash 格式的 YAML,以便我可以访问 Hash 格式的 hash 格式的 YAML 数据?
Thanks Jeevan谢谢吉文
I tried to found a ready to use solution and found none.我试图找到一个现成的解决方案,但没有找到。 I made something usable.我做了一些有用的东西。 It is not pure YAML interpreter but can parse key:value data.它不是纯 YAML 解释器,但可以解析 key:value 数据。
Function VBA ParseYAML函数 VBA ParseYAML
Sub ParseYAML()
Dim myFile As String, text As String, textline As String
' open YAML file
myFile = Application.GetOpenFilename()
' verify if a file were open
If Not myFile = "Falsch" Then
Open myFile For Input As #1
Dim dataArray
Dim c As Collection
Set c = New Collection
Line = 0
Do Until EOF(1)
Line Input #1, textline
oneline = Replace(textline, " ", "")
dataArray = Split(oneline, ":", 2)
sizeArray = UBound(dataArray, 1) - LBound(dataArray, 1) + 1
' Verification Empty Lines and Split don't occur
If Not textline = "" And Not sizeArray = 0 Then
Data = dataArray(1)
Key = dataArray(0)
' test if line don't start with -
If InStr(1, Key, "-") = 0 Then
c.Add Data, Key
End If
' just for debug
Line = Line + 1
'text = text & textline
End If
Loop
Close #1
Range("D6").Value = c.Item("key1")
Range("D7").Value = c.Item("key2")
Range("C18").Value = c.Item("key3")
Set c = Nothing
End If
End Sub
Example of YAML file YAML 文件示例
- section1: - 第 1 节:
key1:data1键 1:数据 1
key2:data2键 2:数据 2
- section2: - 第2节:
key3:data3键 3:数据 3
If using cJObject.cls, we can convert a yaml file to cJObject.如果使用 cJObject.cls,我们可以将 yaml 文件转换为 cJObject。
https://medium.com/@sakai.memoru/convert-a-yaml-file-to-cjobject-in-vba-2fee22e85818 https://medium.com/@sakai.memoru/convert-a-yaml-file-to-cjobject-in-vba-2fee22e85818
Example YAML file示例 YAML 文件
# YAML
martin:
name: Martin Jobson
job: Developer
skills:
- fortran
- lisp
- erlang
Code sample代码示例
Sub TestYaml2Json()
'''' *********************************************
''
Dim objYaml As O_YAML
Set objYaml = New O_YAML
''
Dim file_name As String
Let file_name = "input/yamlformat.yaml"
''
Dim jObj As cJobject
Set jObj = New cJobject
''
Set jObj = objYaml.YamlFileToJObject(file_name)
Console.info jObj.formatData
Console.info jObj.serialize
''
End Sub
immediate windows即时窗口
{“martin”:{“name”:”Martin Jobson”,”job”:”Developer”,”skills”:[“fortran”,”lisp”,”erlang” ]}}
Expanding on cgasp 's answer this function kind of handles nesting and loads a YAML file into an array, additionally it can run in VBA, VBS, HTA contexts.扩展cgasp的答案,此函数处理嵌套并将 YAML 文件加载到数组中,此外它还可以在 VBA、VBS、HTA 上下文中运行。
Public Function ParseYAMLtoArray(ByVal filePath) ' as array
' Version 1.0.4
' Dependencies: NONE
' Modified from this post: https://stackoverflow.com/a/40659701/1146659
' License: - CC BY-SA 4.0 - <https://creativecommons.org/licenses/by-sa/4.0/>
' Contributors: cgasp <https://stackoverflow.com/users/1862421/cgasp>; Jeremy D. Gerdes <jeremy.gerdes@navy.mil>;
' Reference: https://yaml.org/refcard.html
' Usage Example: debug.print ParseYAMLtoArray(GetCurrentFileFolder() & "\" & "documentation" & "\" & "exampleNested.yaml")(1,3)
' Notes: Using late binding to run for all vb engines
' -------------------------------
' Known ParserIssues:
' - Niave: This is not spec conforming, just usefull enough, use another parser if you need more features.
' See spec at: http://yaml.org/spec/1.2/spec.html
' - A block scalar indicator should include all subsequent rows that have the same white space intentation past the current line
' this parser fails to do this if any of those following row contains a ":"
' - YAML denotes nesting via indent delimitation (white space), this parser attempts to record nested "{level=n}" in the data
' column for each empty Category, and ignores all other nesting.
' -This parser ignores all cast data types like "!!float " whatever is accepting the results of this Public Function will
' have to handle any type casting in the YAML document.
Const ForReading = 1
Dim arryReturn() ' As variant
Dim text ' As String
Dim textline ' As String
Dim objFSO 'As Scripting.FileSystemObject
Dim objFile 'As Scripting.TextStream
Dim intLastLineWhiteSpace 'As Integer
Dim dataArray 'As Variant
Dim sizeArray 'As Long
Dim oneline 'As String
Dim Data 'As Variant
Dim Key 'As Variant
Dim intRow 'as integer
Dim intColumn 'as integer
Dim intNestingLevel 'As Integer
Dim intLastNestingSpaces 'As Integer
Dim intCurrentNestingSpaces 'As Integer
Dim intThisLineWhiteSpace
Dim fIsNestedHeader
Set objFSO = CreateObject("Scripting.FileSystemObject")
' verify if file exists
If objFSO.FileExists(filePath) Then
Set objFile = objFSO.GetFile(filePath).OpenAsTextStream(ForReading)
'Open FilePath For Input As #1
intRow = 0
intNestingLevel = 1
Do Until objFile.AtEndOfStream
intThisLineWhiteSpace = Len(textline) - Len(LTrim(textline))
textline = objFile.ReadLine
oneline = Trim(textline) 'remove leading/trailing spaces
' test if line doesn't start with --- or #
If Left(oneline, 3) <> "---" And Left(oneline, 1) <> "#" Then
dataArray = Split(oneline, ":", 2)
sizeArray = UBound(dataArray, 1) - LBound(dataArray, 1) + 1
' Verification Empty Lines and Split don't occur
If Not Len(oneline) = 0 And Not sizeArray = 0 Then
fIsNestedHeader = False
If sizeArray = 1 And intThisLineWhiteSpace > intLastLineWhiteSpace Then ' HEADER
fIsNestedHeader = True
ElseIf sizeArray = 2 Then ' HEADER: <NULL>
fIsNestedHeader = Len(Trim(dataArray(0))) <> 0 And Len(Trim(dataArray(1))) = 0
End If
If sizeArray = 1 And intThisLineWhiteSpace >= intLastLineWhiteSpace And Len(Trim(dataArray(0))) > 0 Then ' semicolins in a block breaks this parser
'assume we are continuing the data from previous line
intRow = intRow - 1 ' use previous row in the array
Data = Trim(dataArray(0))
'remove leading block annotation | or >
If arryReturn(1, intRow) = "|" Or arryReturn(1, intRow) = ">" Then
If Len(arryReturn(1, intRow)) = 1 Then
arryReturn(1, intRow) = vbNullString
Else
arryReturn(1, intRow) = Right(arryReturn(1, intRow), Len(arryReturn(1, intRow) - 1))
End If
End If
arryReturn(1, intRow) = arryReturn(1, intRow) & vbCrLf & Data
ElseIf fIsNestedHeader Then
'Category/Header
Key = Trim(dataArray(0))
ReDim Preserve arryReturn(1, intRow)
arryReturn(0, intRow) = Key
' calculate nesting level - just kind of works,
' doesn't really map to what's in the YAML as nesting back up is actually dependent on the number of spaces not previous nesting...
intCurrentNestingSpaces = intThisLineWhiteSpace
If intThisLineWhiteSpace = 0 Then
'We are back at level 1
intNestingLevel = 1
Else
If intCurrentNestingSpaces > intLastNestingSpaces Then
intNestingLevel = intNestingLevel + 1
ElseIf intCurrentNestingSpaces < intLastNestingSpaces Then
intNestingLevel = intNestingLevel - 1
'Else 'should be equal so intNestingLevel, stays the same
'intCurrentNestingSpaces = intLastNestingSpaces
End If
End If
arryReturn(1, intRow) = "{level=" & intNestingLevel & "}"
intLastNestingSpaces = intThisLineWhiteSpace
Else
Data = Trim(dataArray(1))
Key = Trim(dataArray(0))
ReDim Preserve arryReturn(1, intRow)
arryReturn(0, intRow) = Key
arryReturn(1, intRow) = Data
End If
intRow = intRow + 1
End If
End If
intLastLineWhiteSpace = Len(textline) - Len(LTrim(textline))
Loop
objFile.Close
Dim arryReturnTemp
'Must build array in Array(column,row) format to be able to append rows in VBScript, now transform to the standard Array(row,column) format
If TransposeArray(arryReturn, arryReturnTemp) Then
ParseYAMLtoArray = arryReturnTemp
Else
Err.Raise vbObjectError + 667, "ParseYAML", "Failed to Transform array"
End If
Else
Err.Raise vbObjectError + 666, "ParseYAML", "Config file not found"
End If
End Function
Public Function TransposeArray(ByRef InputArr, ByRef OutputArr) 'As Variant, ByRef OutputArr As Variant) As Boolean
' Version 1.0.0
' Dependencies: NONE
' Note: The following Public Function has been modified by jeremy.gerdes@navy.mil to conform to VBScipt from:
' http://www.cpearson.com/excel/vbaarrays.htm
' License: Charles H. Pearson. All of the formulas and VBA code are explicitly granted to the Public Domain. You may use the formulas and VBA code on this site for any purpose you see fit without permission from me. This includes inclusion in commercial works and works for hire. By using the formula and code on this site, you agree to hold Charles H. Pearson and Pearson Software Consulting, LLC, free of any liability. The formulas and code are presented as is and the author makes no warranty, express or implied, of their fitness for use. You assume all responsibility for testing and ensuring that the code works properly in your environment
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TransposeArray
' This transposes a two-dimensional array. It returns True if successful or
' False if an error occurs. InputArr must be two-dimensions. OutputArr must be
' a dynamic array. It will be Erased and resized, so any existing content will
' be destroyed.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim RowNdx ' As Long
Dim ColNdx ' As Long
Dim LB1 ' As Long
Dim LB2 ' As Long
Dim UB1 ' As Long
Dim UB2 ' As Long
'''''''''''''''''''''''''''''''''''
' Ensure InputArr is an array
'''''''''''''''''''''''''''''''''''
If (IsArray(InputArr) = False) Then
TransposeArray = False
Exit Function
End If
'''''''''''''''''''''''''''''''''''''''
' Get the Lower and Upper bounds of
' InputArr.
'''''''''''''''''''''''''''''''''''''''
LB1 = LBound(InputArr, 1)
LB2 = LBound(InputArr, 2)
UB1 = UBound(InputArr, 1)
UB2 = UBound(InputArr, 2)
'''''''''''''''''''''''''''''''''''''''''
' Erase and ReDim OutputArr
'''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
'If it's an array empty it, if not then it's empty
Erase OutputArr
On Error GoTo 0
'In VBS we can't ReDim Array(LowBound To HighBound) all arrays must conform to Lbound = 0
If LB1 <> 0 Or LB2 <> 0 Then
TransposeArray = False
Exit Function
End If
ReDim OutputArr(UB2, UB1)
For RowNdx = LBound(InputArr, 2) To UBound(InputArr, 2)
For ColNdx = LBound(InputArr, 1) To UBound(InputArr, 1)
OutputArr(RowNdx, ColNdx) = InputArr(ColNdx, RowNdx)
Next ' ColNdx
Next ' RowNdx
TransposeArray = True
End Function
YAML will parse better into a Dictionary or Collection then an array, the above solution was created to run in Scripts but will still work in Excel. YAML 将更好地解析为字典或集合,然后是数组,上述解决方案是为在脚本中运行而创建的,但仍可在 Excel 中运行。
To use this function in excel we can map arrays directly to a ranges values like this:要在 excel 中使用此函数,我们可以将数组直接映射到范围值,如下所示:
Public Sub ToolTestImportYaml(strYamlFilePath As String, rngDestination As Range)
Dim arryYaml As Variant
Dim rngDestinationReturn As Range
arryYaml = ParseYAMLtoArray(strYamlFilePath)
rngDestination.Worksheet.Activate
rngDestination.Activate
Set rngDestinationReturn = rngDestination.Worksheet.Range( _
rngDestination.Address, _
rngDestination.Offset( _
UBound(arryYaml, 1) - LBound(arryYaml, 1), _
UBound(arryYaml, 2) - LBound(arryYaml, 2) _
).Address _
)
'Assign the values to the destination range
rngDestinationReturn.Value = arryYaml
End Sub
And call with:并致电:
ToolTestImportYaml ThisWorkbook.path & "\" & "exampleNested.yaml", ActiveSheet.Range("a1")
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.