Reading a JSON and looping in VBA - json

I'm getting from the server a JSON string with the statuses of a particular actions. In this case it returns results for 2 actions.
For
ID: 551720
and
ID: 551721
String looks like this:
[{"ElectronicId":551720,"DocumentNr":"130/10/15",
"DocumentTypeId":1,"DocumentTypeName":"eInvoice",
"StatusId":30,"StatusName":"Sent","RecipientBusinessNumber":"0050960000",
"RecipientBusinessUnit":"","RecipientBusinessName":"Comp d.o.o.",
"Created":"2019-07-23T21:21:23.743","Updated":"2019-07-23T21:21:24.587",
"Sent":"2019-07-23T21:21:24.587","Delivered":null},
{"ElectronicId":551721,"DocumentNr":"130/10/15",
"DocumentTypeId":1,"DocumentTypeName":"eInvoice",
"StatusId":30,"StatusName":"Sent","RecipientBusinessNumber":"00509605454",
"RecipientBusinessUnit":"","RecipientBusinessName":"Comp d.o.o.",
"Created":"2019-07-23T21:23:05.887","Updated":"2019-07-23T21:23:07.043",
"Sent":"2019-07-23T21:23:07.043","Delivered":null}]
Sometimes it returns 1, sometimes 2, or maybe 20 statuses (different "ElectronicId")
How could I loop within JSON.
I have a code that works when I have only 1 response, but it doesn't work when I have more than 1.
Here is the code for 1 response:
Dim cJS As New clsJasonParser
cJS.InitScriptEngine
results = """""here goes the JSON string""""""
Set JsonObject = cJS.DecodeJsonString(CStr(result))
Debug.Print cJS.GetProperty(JsonObject, "ElectronicId")
Debug.Print cJS.GetProperty(JsonObject, "DocumentNr")
Debug.Print cJS.GetProperty(JsonObject, "DocumentTypeId")
Debug.Print cJS.GetProperty(JsonObject, "DocumentTypeName")
Debug.Print cJS.GetProperty(JsonObject, "StatusId")
Here is the code for the clsJasonParser bClass:
Option Explicit
Private ScriptEngine As ScriptControl
Public Sub InitScriptEngine()
Set ScriptEngine = New ScriptControl
ScriptEngine.Language = "JScript"
ScriptEngine.AddCode "function getProperty(jsonObj, propertyName) { return jsonObj[propertyName]; } "
ScriptEngine.AddCode "function getKeys(jsonObj) { var keys = new Array(); for (var i in jsonObj) { keys.push(i); } return keys; } "
End Sub
Public Function DecodeJsonString(ByVal JsonString As String)
Set DecodeJsonString = ScriptEngine.Eval("(" + JsonString + ")")
End Function
Public Function GetProperty(ByVal JsonObject As Object, ByVal propertyName As String) As Variant
GetProperty = ScriptEngine.Run("getProperty", JsonObject, propertyName)
End Function
Public Function GetObjectProperty(ByVal JsonObject As Object, ByVal propertyName As String) As Object
Set GetObjectProperty = ScriptEngine.Run("getProperty", JsonObject, propertyName)
End Function

I would use jsonconverter.bas to parse the json. After installing the code from that link in a standard module called JsonConverter, go to VBE > Tools > References > Add a reference to Microsoft Scripting Runtime.
Then I would dimension an array to hold the results. I would determine rows from the number of items in the json collection returned and the number of columns from the size of the first item dictionary. Loop the json object, and inner loop the dictionary keys of each dictionary in collection, and populate the array. Write the array out in one go at end.
Below, I am reading in the json string from cell A1 but you would replace that with your json source.
Option Explicit
Public Sub test()
Dim json As Object, r As Long, c As Long, headers()
Dim results(), ws As Worksheet, item As Object, key As Variant
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set json = JsonConverter.ParseJson(ws.[A1].Value) '<Reading json from cell. Returns collection
headers = json.item(1).keys 'each item in collection is a dictionary. Use .keys to get headers for results e.g. ElectronicId
ReDim results(1 To json.Count, 1 To UBound(headers) + 1)
For Each item In json 'loop json and populate results array
r = r + 1: c = 1
For Each key In item.keys
results(r, c) = item(key)
c = c + 1
Next
Next
With ws
.Cells(2, 1).Resize(1, UBound(headers) + 1) = headers
.Cells(3, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
End With
End Sub

Related

How to make my VB.NET code dynamic instead of static?

The following code gives me the error system.argumentexception an element with the same key already exists. When I use in the the Friend Sub Test the following line instead: 'Dim str_rootdirectory As String = Directory.GetCurrentDirectory() ' "C:\TEMP" it works. Whats the difference?
My VB.NET code:
Public Class Form1
Public Sub recur_getdirectories(ByVal di As DirectoryInfo)
For Each directory As DirectoryInfo In di.GetDirectories()
'get each directory and call the module main to get the security info and write to json
Call Module1.Main(directory.FullName)
recur_getdirectories(directory)
Next
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim rootDirectory As String = TextBox1.Text.Trim()
Dim di As New DirectoryInfo(rootDirectory)
'get directories recursively and work with each of them
recur_getdirectories(di)
End Sub
End Class
Public Module RecursiveEnumerableExtensions
Iterator Function Traverse(Of T)(ByVal root As T, ByVal children As Func(Of T, IEnumerable(Of T)), ByVal Optional includeSelf As Boolean = True) As IEnumerable(Of T)
If includeSelf Then Yield root
Dim stack = New Stack(Of IEnumerator(Of T))()
Try
stack.Push(children(root).GetEnumerator())
While stack.Count <> 0
Dim enumerator = stack.Peek()
If Not enumerator.MoveNext() Then
stack.Pop()
enumerator.Dispose()
Else
Yield enumerator.Current
stack.Push(children(enumerator.Current).GetEnumerator())
End If
End While
Finally
For Each enumerator In stack
enumerator.Dispose()
Next
End Try
End Function
End Module
Public Module TestClass
Function GetFileSystemAccessRule(d As DirectoryInfo) As IEnumerable(Of FileSystemAccessRule)
Dim ds As DirectorySecurity = d.GetAccessControl()
Dim arrRules As AuthorizationRuleCollection = ds.GetAccessRules(True, True, GetType(Security.Principal.NTAccount))
For Each authorizationRule As FileSystemAccessRule In arrRules
Dim strAclIdentityReference As String = authorizationRule.IdentityReference.ToString()
Dim strInheritanceFlags As String = authorizationRule.InheritanceFlags.ToString()
Dim strAccessControlType As String = authorizationRule.AccessControlType.ToString()
Dim strFileSystemRights As String = authorizationRule.FileSystemRights.ToString()
Dim strIsInherited As String = authorizationRule.IsInherited.ToString()
Next
' This function should return the following values, because they should be mentoined in the JSON:
' IdentityReference = strAclIdentityReference
' InheritanceFlags = strInheritanceFlags
' AccessControlType = strAccessControlType
' FileSystemRights = strFileSystemRights
' IsInherited = strIsInherited
Return ds.GetAccessRules(True, True, GetType(System.Security.Principal.NTAccount)).Cast(Of FileSystemAccessRule)()
End Function
Friend Sub Test(ByVal curDirectory As String)
'Dim str_rootdirectory As String = Directory.GetCurrentDirectory() ' "C:\TEMP"
Dim str_rootdirectory As String = curDirectory
Dim di As DirectoryInfo = New DirectoryInfo(str_rootdirectory)
Dim directoryQuery = RecursiveEnumerableExtensions.Traverse(di, Function(d) d.GetDirectories())
Dim list = directoryQuery.Select(
Function(d) New With {
.directory = d.FullName,
.permissions = {
GetFileSystemAccessRule(d).ToDictionary(Function(a) a.IdentityReference.ToString(), Function(a) a.FileSystemRights.ToString())
}
}
)
Dim json = JsonConvert.SerializeObject(list, Formatting.Indented)
File.WriteAllText("ABCD.json", json)
End Sub
End Module
Public Module Module1
Public Sub Main(ByVal curDirectory As String)
Console.WriteLine("Environment version: " & Environment.Version.ToString())
Console.WriteLine("Json.NET version: " & GetType(JsonSerializer).Assembly.FullName)
Console.WriteLine("")
Try
TestClass.Test(curDirectory)
Catch ex As Exception
Console.WriteLine("Unhandled exception: ")
Console.WriteLine(ex)
Throw
End Try
End Sub
End Module
My example folder structure:
Folder: "C:\Temp"
Permissions: SecurityGroup-A has Fullcontrol,
SecurityGroup-B has Modify permission
Folder: "C:\Temp\Folder_A"
Permissions: SecurityGroup-C has Fullcontrol
But this is only an example of two folders. In real, it will run over several hundered folders with sub-folders. Accordingly the JSON will extend.
My json output expectation:
[{
"directory": "C:\\TEMP",
"permissions": [{
"IdentityReference": "CONTOSO\\SecurityGroup-A",
"AccessControlType": "Allow",
"FileSystemRights": "FullControl",
"IsInherited": "TRUE"
}, {
"IdentityReference": "CONTOSO\\SecurityGroup-B",
"AccessControlType": "Allow",
"FileSystemRights": "Modify",
"IsInherited": "False"
}
]
}, {
"directory": "C:\\TEMP\\Folder_A",
"permissions": [{
"IdentityReference": "CONTOSO\\SecurityGroup-C",
"AccessControlType": "Allow",
"FileSystemRights": "Full Control",
"IsInherited": "False"
}
]
}
]
Your current JSON uses static property names for the [*].permissions[*] objects so there is no need to try to convert a list of them into a dictionary with variable key names via ToDictionary():
' This is not needed
.permissions = {
GetFileSystemAccessRule(d).ToDictionary(Function(a) a.IdentityReference.ToString(), Function(a) a.FileSystemRights.ToString())
}
Instead, convert each FileSystemAccessRule into some appropriate DTO for serialization. An anonymous type object works nicely for this purpose:
Public Module DirectoryExtensions
Function GetFileSystemAccessRules(d As DirectoryInfo) As IEnumerable(Of FileSystemAccessRule)
Dim ds As DirectorySecurity = d.GetAccessControl()
Dim arrRules As AuthorizationRuleCollection = ds.GetAccessRules(True, True, GetType(Security.Principal.NTAccount))
Return arrRules.Cast(Of FileSystemAccessRule)()
End Function
Public Function SerializeFileAccessRules(ByVal curDirectory As String, Optional ByVal formatting As Formatting = Formatting.Indented)
Dim di As DirectoryInfo = New DirectoryInfo(curDirectory)
Dim directoryQuery = RecursiveEnumerableExtensions.Traverse(di, Function(d) d.GetDirectories())
Dim list = directoryQuery.Select(
Function(d) New With {
.directory = d.FullName,
.permissions = GetFileSystemAccessRules(d).Select(
Function(a) New With {
.IdentityReference = a.IdentityReference.ToString(),
.AccessControlType = a.AccessControlType.ToString(),
.FileSystemRights = a.FileSystemRights.ToString(),
.IsInherited = a.IsInherited.ToString()
}
)
}
)
Return JsonConvert.SerializeObject(list, formatting)
End Function
End Module
Public Module RecursiveEnumerableExtensions
' Translated to vb.net from this answer https://stackoverflow.com/a/60997251/3744182
' To https://stackoverflow.com/questions/60994574/how-to-extract-all-values-for-all-jsonproperty-objects-with-a-specified-name-fro
' which was rewritten from the answer by Eric Lippert https://stackoverflow.com/users/88656/eric-lippert
' to "Efficient graph traversal with LINQ - eliminating recursion" https://stackoverflow.com/questions/10253161/efficient-graph-traversal-with-linq-eliminating-recursion
Iterator Function Traverse(Of T)(ByVal root As T, ByVal children As Func(Of T, IEnumerable(Of T)), ByVal Optional includeSelf As Boolean = True) As IEnumerable(Of T)
If includeSelf Then Yield root
Dim stack = New Stack(Of IEnumerator(Of T))()
Try
stack.Push(children(root).GetEnumerator())
While stack.Count <> 0
Dim enumerator = stack.Peek()
If Not enumerator.MoveNext() Then
stack.Pop()
enumerator.Dispose()
Else
Yield enumerator.Current
stack.Push(children(enumerator.Current).GetEnumerator())
End If
End While
Finally
For Each enumerator In stack
enumerator.Dispose()
Next
End Try
End Function
End Module
Demo fiddle here (which unfortunately does not work on https://dotnetfiddle.net because of security restrictions on client code but should be runnable in full trust).

How to get all subnodes in a JSON file using JSON.Net

I wan't to get all subnodes in a JSON file using JSON.NET is it possible ?
Here is my code :
Shared Function LoadBranch(ByVal branch As String, ByVal tv As TreeView)
Dim jsonstr As String = FileIO.FileSystem.ReadAllText(FileIO.FileSystem.ReadAllText(".\temp\localpath.txt"))
Dim obj As JObject = JObject.Parse(jsonstr)
Dim result As List(Of JToken) = obj.Children().ToList()
For Each item As JProperty In result
Dim rootName As String = item.Name
If branch = rootName Then
Dim root As TreeNode = tv.Nodes.Add(rootName)
For Each child In item.Children()
For Each jprop As JProperty In child
root.Nodes.Add(String.Format("{0} : {1}", jprop.Name, jprop.Value))
Next
Next
End If
Next
Return True
End Function

Reading Json object in VBA

I had tried the previous answer. Everything works fine until my data which extracted from server in the form of Json is giving me a key with multiple objects
Excel VBA: Parsed JSON Object Loop
something like this
{"messageCode":null,"responseStatus":"success","message":null,"resultObject":null,"resultObject2":[{"fxCcyPair":"USD"}, {"fxCcyPair":"EUR"},{"fxCcyPair":"JPY"},{"fxCcyPair":"GBD"}],"resultObject3":null,"resultObject4":null}
How can I get the value in "resultObject2"? as there is no key for me to refer and I am not able to loop the object out from it.
Public Sub InitScriptEngine()
Set ScriptEngine = New ScriptControl
ScriptEngine.Language = "JScript"
ScriptEngine.AddCode "function getProperty(jsonObj, propertyName) { return jsonObj[propertyName]; } "
ScriptEngine.AddCode "function getKeys(jsonObj) { var keys = new Array(); for (var i in jsonObj) { keys.push(i); } return keys; } "
ScriptEngine.AddCode "function getSentenceCount(){return obj.sentences.length;}"
ScriptEngine.AddCode "function getSentence(i){return obj.sentences[i];}"
End Sub
Public Function DecodeJsonString(ByVal JsonString As String)
Set DecodeJsonString = ScriptEngine.Eval("(" + JsonString + ")")
End Function
Public Function GetProperty(ByVal JsonObject As Object, ByVal propertyName As String) As Variant
GetProperty = ScriptEngine.Run("getProperty", JsonObject, propertyName)
End Function
Public Function GetObjectProperty(ByVal JsonObject As Object, ByVal propertyName As String) As Object
Set GetObjectProperty = ScriptEngine.Run("getProperty", JsonObject, propertyName)
End Function
Public Function GetKeys(ByVal JsonObject As Object) As String()
Dim Length As Integer
Dim KeysArray() As String
Dim KeysObject As Object
Dim index As Integer
Dim Key As Variant
Set KeysObject = ScriptEngine.Run("getKeys", JsonObject)
Length = GetProperty(KeysObject, "length")
ReDim KeysArray(Length - 1)
index = 0
For Each Key In KeysObject
KeysArray(index) = Key
Debug.Print Key
index = index + 1
Next
GetKeys = KeysArray
End Function
Thanks
This is a bit more manageable I think (based on S Meaden's answer at your linked question)
Sub TestJSONParsingWithVBACallByName()
Dim oScriptEngine As ScriptControl
Set oScriptEngine = New ScriptControl
oScriptEngine.Language = "JScript"
Dim objJSON As Object, arr As Object, el
'I pasted your JSON in A1 for testing...
Set objJSON = oScriptEngine.Eval("(" + Range("A1").Value + ")")
Debug.Print VBA.CallByName(objJSON, "responseStatus", VbGet)
'get the array associated with "resultObject2"
Set arr = VBA.CallByName(objJSON, "resultObject2", VbGet)
Debug.Print VBA.CallByName(arr, "length", VbGet) 'how many elements?
'loop over the array and print each element's "fxCcyPair" property
For Each el In arr
Debug.Print VBA.CallByName(el, "fxCcyPair", VbGet)
Next el
End Sub
Output:
success
4
USD
EUR
JPY
GBD

Deserializing JSON in Visual basic

Basically, I'm trying to parse the comments from a 4chan thread using the 4chan JSON API. https://github.com/4chan/4chan-API
basically, there is one rich text box called input, and another called post_text_box. What im trying to do is make it so that JSON from a 4chan thread entered in the input text box, and comments are extracted from that JSON and displayed in the output text box
however, whenever I try clicking the Go button nothing happens.
Here is my code so far
Imports System.Web.Script.Serialization
Imports Newtonsoft.Json
Imports Newtonsoft.Json.Linq
Public Class Form1
Private Sub start_button_Click(sender As Object, e As EventArgs) Handles start_button.Click
Dim j As Object = New JavaScriptSerializer().Deserialize(Of Post)(input.Text)
post_text_box.Text = j.com
End Sub
End Class
Public Class Rootobject
Public Property posts() As Post
End Class
Public Class Post
Public Property no As Integer
Public Property now As String
Public Property name As String
Public Property com As String
Public Property filename As String
Public Property ext As String
Public Property w As Integer
Public Property h As Integer
Public Property tn_w As Integer
Public Property tn_h As Integer
Public Property tim As Long
Public Property time As Integer
Public Property md5 As String
Public Property fsize As Integer
Public Property resto As Integer
Public Property bumplimit As Integer
Public Property imagelimit As Integer
Public Property replies As Integer
Public Property images As Integer
End Class
Since you're importing Newtonsoft.Json, you can just use the JsonConvert.DeserializeObject<T>(String) method:
Dim exampleJson As String = "{ 'no':'123', 'name':'Some Name', 'com':'This is a comment'}"
Dim post As Post = JsonConvert.DeserializeObject(Of Post)(exampleJson)
Dim com As String = post.com
post_text_box.Text = com
Alternatively, if you don't want to create a class for Post, you can use JsonConvert.DeserializeAnonymousType<T>(String, T):
Dim exampleJson As String = "{ 'no':'123', 'name':'Some Name', 'com':'This is a comment'}"
Dim tempPost = New With {Key .com = ""}
Dim post = JsonConvert.DeserializeAnonymousType(exampleJson, tempPost)
Dim com As String = post.com
post_text_box.Text = com
EDIT: It looks like you're getting an array back from the API:
{
"posts" : [{
"no" : 38161812,
"now" : "11\/19\/13(Tue)15:18",
"name" : "Anonymous",
"com" : ‌​ "testing thread for JSON stuff",
"filename" : "a4c",
"ext" : ".png",
"w" : 386,
"h" : 378,
"tn_w" : 250,
"tn_h" : 244,
"tim" ‌​ : 1384892303386,
"time" : 1384892303,
"md5" : "tig\/aNmBqB+zOZY5upx1Fw==",
"fsize" : 6234,
"‌​resto" : 0,
"bumplimit" : 0,
"imagelimit" : 0,
"replies" : 0,
"images" : 0
}
]
}
In that case, you will need to change the type that is being deserialized to Post():
First, add another small wrapper class:
Public Class PostWrapper
Public posts() As Post
End Class
Then adjust your deserialization code:
Dim json As String = input_box.Text
Dim postWrapper = JsonConvert.DeserializeObject(Of PostWrapper)(json) ' Deserialize array of Post objects
Dim posts = postWrapper.posts
If posts.Length = 1 Then ' or whatever condition you prefer
post_text_box.Text = posts(0).com
End If
Instead of needing to define a class, you can deserialize the JSON into an Object, like this:
Dim json As String = "{""items"":[{""Name"":""John"",""Age"":""20"",""Gender"":""Male""},{""Name"":""Tom"",""Age"":""25"",""Gender"":""Male""},{""Name"":""Sally"",""Age"":""30"",""Gender"":""Female""}]}"
Dim jss = New JavaScriptSerializer()
Dim data = jss.Deserialize(Of Object)(json)
Now, as an example, you could loop through the deserialized JSON and build an HTML table, like this:
Dim sb As New StringBuilder()
sb.Append("<table>" & vbLf & "<thead>" & vbLf & "<tr>" & vbLf)
' Build the header based on the keys of the first data item.
For Each key As String In data("items")(0).Keys
sb.AppendFormat("<th>{0}</th>" & vbLf, key)
Next
sb.Append("</tr>" & vbLf & "</thead>" & vbLf & "<tbody>" & vbLf)
For Each item As Dictionary(Of String, Object) In data("items")
sb.Append("<tr>" & vbLf)
For Each val As String In item.Values
sb.AppendFormat(" <td>{0}</td>" & vbLf, val)
Next
Next
sb.Append("</tr>" & vbLf & "</tbody>" & vbLf & "</table>")
Dim myTable As String = sb.ToString()
Disclaimer: I work with C# on a daily basis and this is a C# example using dynamic that was converted to VB.NET, please forgive me if there are any syntax errors with this.
Note:
First you have to install Newtonsoft.Json on nuget console. Then include following code on top of your code.
Imports Newtonsoft.Json
Step:1 Create class with get & set properties.
Public Class Student
Public Property rno() As String
Get
Return m_rno
End Get
Set(value As String)
m_rno = value
End Set
End Property
Private m_rno As String
Public Property name() As String
Get
Return m_name
End Get
Set(value As String)
m_name = value
End Set
End Property
Private m_name As String
Public Property stdsec() As String
Get
Return m_StdSec
End Get
Set(value As String)
m_StdSec = value
End Set
End Property
Private m_stdsec As String
End Class
Step: 2 Create string as a json format and conver as a json object model.
Dim json As String = "{'rno':'09MCA08','name':'Kannadasan Karuppaiah','stdsec':'MCA'}"
Dim stuObj As Student = JsonConvert.DeserializeObject(Of Student)(json)
Step: 3 Just traverses by object.entity name as follows.
MsgBox(stuObj.rno)
MsgBox(stuObj.name)
MsgBox(stuObj.stdsec)
Also, if you have complex json string. If there is subclasses, arrays, etc. in the json string, you can use this way at below. I tried it and it worked for me. I hope it will useful for you.
I accessed root->simpleforecast->forecastday[]->date->hight->celsius,fahrenheit values etc. in the json string.
Dim tempforecast = New With {Key .forecast = New Object}
Dim sFile As String = SimpleTools.RWFile.ReadFile("c:\\testjson\\test.json")
Dim root = JsonConvert.DeserializeAnonymousType(sFile, tempforecast)
Dim tempsimpleforecast = New With {Key .simpleforecast = New Object}
Dim forecast = jsonConvert.DeserializeAnonymousType(root.forecast.ToString(), tempsimpleforecast)
Dim templstforecastday = New With {Key .forecastday = New Object}
Dim simpleforecast = JsonConvert.DeserializeAnonymousType(forecast.simpleforecast.ToString(), templstforecastday)
Dim lstforecastday = simpleforecast.forecastday
For Each jforecastday In lstforecastday
Dim tempDate = New With {Key .date = New Object, .high = New Object, .low = New Object}
Dim forecastday = JsonConvert.DeserializeAnonymousType(jforecastday.ToString(), tempDate)
Dim tempDateDetail = New With {Key .day = "", .month = "", .year = ""}
Dim fcDateDetail = JsonConvert.DeserializeAnonymousType(forecastday.date.ToString(), tempDateDetail)
Weather_Forcast.ForcastDate = fcDateDetail.day.ToString() + "/" + fcDateDetail.month.ToString() + "/" + fcDateDetail.year.ToString()
Dim temphighDetail = New With {Key .celsius = "", .fahrenheit = ""}
Dim highDetail = JsonConvert.DeserializeAnonymousType(forecastday.high.ToString(), temphighDetail)
Dim templowDetail = New With {Key .celsius = "", .fahrenheit = ""}
Dim lowDetail = JsonConvert.DeserializeAnonymousType(forecastday.low.ToString(), templowDetail)
Weather_Forcast.highCelsius = Decimal.Parse(highDetail.celsius.ToString())
Weather_Forcast.lowCelsius = Decimal.Parse(lowDetail.celsius.ToString())
Weather_Forcast.highFahrenheit = Decimal.Parse(lowDetail.fahrenheit.ToString())
Weather_Forcast.lowFahrenheit = Decimal.Parse(lowDetail.fahrenheit.ToString())
Weather_Forcast09_Result.Add(Weather_Forcast)
Next

save x,y spectrum data in table in ms-access

I want to create a table for LEDs. This table creates information such as name, center wavelength and the spectrum, which itself is data in the format intensity over wavelenth as 2 x n table data.
I am a beginner in access and have currently no clue how to insert this to a table.
I could of course create for each LED a table on its own, but there will be hundreds of these spectrum datas.
Such a complex data structure may be difficult to implement in a database table. An option I propose is to have a set of classes that represent the data. Then you can serialize and deserialize (read and write) the data to a file.
Sample Implementation
Module Module1
Sub Main()
Dim leds = New List(Of LED)()
Dim rnd = New Random()
'create a bunch of LEDs
For i = 1 To 10
Dim led = New LED("LED " & (i + 1).ToString(), rnd.Next(0, i * 100))
For x = 1 To 10
led.Spectrum.Add(New SpectrumInfo(rnd.Next(1, 10), rnd.Next(1000, 10000)))
Next
leds.Add(led)
Next
' write the led data to a file
Using sw As New IO.StreamWriter("LED Data.ledx")
Dim xs = New System.Xml.Serialization.XmlSerializer(leds.GetType())
xs.Serialize(sw, leds)
End Using
'read the led data from a file
Dim leds2 = New List(Of LED)()
Using sr = New System.IO.StreamReader("LED Data.ledx")
Dim xs = New System.Xml.Serialization.XmlSerializer(leds2.GetType())
leds2 = DirectCast(xs.Deserialize(sr), List(Of LED))
End Using
'confirm the two are the same
Console.WriteLine("LEDs and LEDS2 are " & If(leds.SequenceEqual(leds2), "the same", "different"))
' alternate saving using binary serializer
' works in cases where XmlSerializer doesn't
' produces smaller files too
'save the led data
Using fs = New System.IO.FileStream("LED Data.ledb", IO.FileMode.Create)
Dim bf = New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter()
bf.Serialize(fs, leds)
End Using
'read the led data
Dim leds3 = New List(Of LED)()
Using fs = New System.IO.FileStream("LED Data.ledb", IO.FileMode.Open)
Dim bf = New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter()
leds3 = DirectCast(bf.Deserialize(fs), List(Of LED))
End Using
'confirm equality
Console.WriteLine("LEDs and LEDS3 are " & If(leds.SequenceEqual(leds3), "the same", "different"))
Console.WriteLine("LEDs2 and LEDS3 are " & If(leds2.SequenceEqual(leds3), "the same", "different"))
Console.ReadLine()
End Sub
End Module
<Serializable()> _
Public Class LED
Dim _name As String
Dim _cWL As Double
Dim _spectrum As List(Of SpectrumInfo)
Public Sub New()
_name = String.Empty
_cWL = 0
_spectrum = New List(Of SpectrumInfo)()
End Sub
Public Sub New(name As String, cwl As Double, ParamArray spectrum() As SpectrumInfo)
_name = name
_cWL = cwl
_spectrum = New List(Of SpectrumInfo)(spectrum)
End Sub
Public Property Name As String
Get
Return _name
End Get
Set(value As String)
_name = value
End Set
End Property
Public Property CenterWavelength As Double
Get
Return _cWL
End Get
Set(value As Double)
_cWL = value
End Set
End Property
Public ReadOnly Property Spectrum As List(Of SpectrumInfo)
Get
Return _spectrum
End Get
End Property
Public Overrides Function Equals(obj As Object) As Boolean
If Not (TypeOf obj Is LED) Then Return False
Dim l2 = DirectCast(obj, LED)
Return l2._name = _name AndAlso l2._cWL = _cWL AndAlso l2._spectrum.SequenceEqual(_spectrum)
End Function
Public Overrides Function ToString() As String
Return String.Format("{0} [{1}]", _name, _cWL)
End Function
Public Overrides Function GetHashCode() As Integer
Dim result As Integer
For Each spec In _spectrum
result = result Xor spec.GetHashCode()
Next
Return result Xor (_name.GetHashCode() + _cWL.GetHashCode())
End Function
End Class
<Serializable()> _
Public Structure SpectrumInfo
Dim _intensity As Double
Dim _wavelength As Double
Public Sub New(intensity As Double, wavelength As Double)
_intensity = intensity
_wavelength = wavelength
End Sub
Public ReadOnly Property Intensity As Double
Get
Return _intensity
End Get
End Property
Public ReadOnly Property Wavelength As Double
Get
Return _wavelength
End Get
End Property
Public Overrides Function Equals(obj As Object) As Boolean
If TypeOf obj Is SpectrumInfo Then
Dim si = DirectCast(obj, SpectrumInfo)
Return si._wavelength = _wavelength AndAlso si._intensity = _intensity
Else
Return False
End If
End Function
Public Overrides Function ToString() As String
Return String.Format("Intensity: {0}, Wavelength: {1}", _intensity, _wavelength)
End Function
Public Overrides Function GetHashCode() As Integer
Return _intensity.GetHashCode() Xor _wavelength.GetHashCode()
End Function
End Structure
You might look at http://r937.com/relational.html
I think you want:
LED Table
ID
LEDName
CenterWavelength
And then a table for spectra
ID
LedId
Intensisty
WaveLength