Comments (3)
Correction: I hadn't properly understand what the code was intended to do, so
my fix above doesn't work. This correction works, but only works for up to 2
dimensions.
You can extend it to more dimensions but it is a faff, and as far as I can tell
there is no way to do call a member of an array in VBA when you have an unknown
number of dimensions.
I have also added the small helper function HowManyDimensions(AnArray). You
also have to change a line of the toString function to read:
toString = multiArray(obj)
Updated multiArray function below, and the full jsonlib file attached.
Private Function multiArray(aBD) ' Array BoDy, Integer BaseCount, String
PoSition
Dim NoDimensions
Dim i1 As Long, i2 As Long
Dim DimList(1 To 10) As Long
NoDimensions = HowManyDimensions(aBD)
Select Case NoDimensions
Case 1
multiArray = multiArray & "["
For i1 = LBound(aBD, 1) To UBound(aBD, 1)
multiArray = multiArray & toString(aBD(i1))
If i1 < UBound(aBD, 1) Then multiArray = multiArray & ","
Next i1
multiArray = multiArray & "]"
Case 2
multiArray = multiArray & "["
For i1 = LBound(aBD, 1) To UBound(aBD, 1)
multiArray = multiArray & "["
For i2 = LBound(aBD, 2) To UBound(aBD, 2)
multiArray = multiArray & toString(aBD(i1, i2))
If i2 < UBound(aBD, 2) Then multiArray = multiArray & ","
Next i2
multiArray = multiArray & "]"
If i1 < UBound(aBD, 1) Then multiArray = multiArray & ","
Next i1
multiArray = multiArray & "]"
Case Else
'Not much point in doing anything here. The error would just leave it blank.
End Select
End Function
Private Function HowManyDimensions(AnArray) As Long
'find number of dimensions
On Error GoTo DimensionOverflow
Dim ErrorCheck As Long, DimensionNumber As Long
For DimensionNumber = 1 To 60001
ErrorCheck = LBound(AnArray, DimensionNumber)
Next DimensionNumber
DimensionOverflow:
HowManyDimensions = DimensionNumber - 1
End Function
Original comment by [email protected]
on 29 Aug 2012 at 11:36
Attachments:
from vba-json.
I was able to make the code work for up to 7 levels of nesting by just using a
call to "split" followed by a select case:
Private Function multiArray(aBD, iBC, sPS, ByRef sPT) ' Array BoDy, Integer
BaseCount, String PoSition
Dim iDU As Long
Dim iDL As Long
Dim i As Long
On Error Resume Next
iDL = LBound(aBD, iBC)
iDU = UBound(aBD, iBC)
Dim SB As New cStringBuilder
Dim sPB1 As String, sPB2 As String, aPB2 As Variant ' String PointBuffer1, String PointBuffer2
If Err.Number = 9 Then
sPB1 = sPT & sPS
For i = 1 To Len(sPB1)
If i <> 1 Then sPB2 = sPB2 & ","
sPB2 = sPB2 & Mid(sPB1, i, 1)
Next
'SB.Append toString(Eval("aBD(" & sPB2 & ")"))
aPB2 = Split(sPB2, ",")
Select Case UBound(aPB2)
Case 0
SB.Append toString(aBD(aPB2(0)))
Case 1
SB.Append toString(aBD(aPB2(0), aPB2(1)))
Case 2
SB.Append toString(aBD(aPB2(0), aPB2(1), aPB2(2)))
Case 3
SB.Append toString(aBD(aPB2(0), aPB2(1), aPB2(2), aPB2(3)))
Case 4
SB.Append toString(aBD(aPB2(0), aPB2(1), aPB2(2), aPB2(3), aPB2(4)))
Case 5
SB.Append toString(aBD(aPB2(0), aPB2(1), aPB2(2), aPB2(3), aPB2(4), aPB2(5)))
Case 6
SB.Append toString(aBD(aPB2(0), aPB2(1), aPB2(2), aPB2(3), aPB2(4), aPB2(5), aPB2(6)))
Case Else
SB.Append "#Nesting too deep#"
End Select
SB.Append toString(aBD(sPB2))
Else
sPT = sPT & sPS
SB.Append "["
For i = iDL To iDU
SB.Append multiArray(aBD, iBC + 1, i, sPT)
If i < iDU Then SB.Append ","
Next
SB.Append "]"
sPT = Left(sPT, iBC - 2)
End If
Err.Clear
multiArray = SB.toString
Set SB = Nothing
End Function
Original comment by [email protected]
on 14 Oct 2014 at 11:25
from vba-json.
Following is better about parseNumber function.
parseNumber = CInt(value)
↓
parseNumber = Clng(value)
Original comment by [email protected]
on 18 May 2015 at 8:32
from vba-json.
Related Issues (20)
- Added suport for JSON-RPC 2.0 in jsonlib
- Enter one-line summary HOT 1
- Cannot parse a JSON string containing an array... HOT 1
- Cannot convert a 2-d array to JSON HOT 1
- Thank you for this code!
- improve parseNumber() with Long number HOT 1
- double backslash parse problem
- String wont parse
- here's an update for office 64-bit support HOT 12
- Unable to parse strings containing colons - Infinite loop HOT 1
- parseNumber and regional settings
- http: 85
- Redundant vbCrLf
- Spaces improperly removed from object keys
- cint in parse number is issue (wont deal with big numbers!) HOT 1
- parseKey with Key containing ":"
- Bug: Case statement comparing one character "\" to "\\" HOT 1
- Need a new owner
- dddd
Recommend Projects
-
React
A declarative, efficient, and flexible JavaScript library for building user interfaces.
-
Vue.js
🖖 Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.
-
Typescript
TypeScript is a superset of JavaScript that compiles to clean JavaScript output.
-
TensorFlow
An Open Source Machine Learning Framework for Everyone
-
Django
The Web framework for perfectionists with deadlines.
-
Laravel
A PHP framework for web artisans
-
D3
Bring data to life with SVG, Canvas and HTML. 📊📈🎉
-
Recommend Topics
-
javascript
JavaScript (JS) is a lightweight interpreted programming language with first-class functions.
-
web
Some thing interesting about web. New door for the world.
-
server
A server is a program made to process requests and deliver data to clients.
-
Machine learning
Machine learning is a way of modeling and interpreting data that allows a piece of software to respond intelligently.
-
Visualization
Some thing interesting about visualization, use data art
-
Game
Some thing interesting about game, make everyone happy.
Recommend Org
-
Facebook
We are working to build community through open source technology. NB: members must have two-factor auth.
-
Microsoft
Open source projects and samples from Microsoft.
-
Google
Google ❤️ Open Source for everyone.
-
Alibaba
Alibaba Open Source for everyone
-
D3
Data-Driven Documents codes.
-
Tencent
China tencent open source team.
from vba-json.