I need to parse JSON text to a JSON object in Excel-VBA. The JSON text includes a matrix/array. Then I need to address it (set a VBA variable to the value).
My code had been working parsing a nested/keyed JSON text with "JsonConverter.parseJSON" method. But I do not know how to address new array object (or technically if the "parse" is working correctly.
Dim jsonResults As String
Dim jsonObj As Dictionary
Set travelDist As Number
Set jsonResults = '{"distances":[[0,97641],[97415,0]],"times":[[0,4189],[4183,0]],"weights":[[0.0,5653.726],[5644.176,0.0]],"info":{"copyrights":["GraphHopper","OpenStreetMap contributors"]}}'
Set jsonObj = JsonConverter.ParseJson(jsonResults) \This worked with the old JSON text keyed value structure.
travelDist = VBA.Val(jsonObj.Item("distances")(1)) \This DOESN'T work. It worked with Keyed Object Values. The goal is to set travelDist to in this example, 97641.
The current code seems to have a type mismatch.
The goal is to set a VBA variable to 97641. Please let me know how to include required files/definitions etc. if the solution is including additional types or methods.
There's no reason to declare jsonObj as a dictionary and unless Number is a well defined user-defined type of some sort, I don't think declaring travelDist as Number will work. Use Double instead. And always use Option Explicit on the very top.
Also the double quotes in the JSON string need to be escaped somehow. You can either double them:
jsonResults = "{""distances"":[[0,97641],[97415,0]],""times"":[[0,4189],[4183,0]],""weights"":[[0.0,5653.726],[5644.176,0.0]],""info"":{""copyrights"":[""GraphHopper"",""OpenStreetMap contributors""]}}"
or replace them with single quotes:
jsonResults = "{'distances':[[0,97641],[97415,0]],'times':[[0,4189],[4183,0]],'weights':[[0.0,5653.726],[5644.176,0.0]],'info':{'copyrights':['GraphHopper','OpenStreetMap contributors']}}"
or you can just store the string in a cell in one of your worksheets and load it from there:
Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets("Name of your Worksheet")
Set jsonObj = JsonConverter.ParseJson(sht.Range("A1"))
Visualizing the JSON structure might help you understand it better:
So basically what you need to do is access the 2nd item, of the 1st item, of the distances array/collection, keeping in mind that the 1st item of the distances array is also an array/collection itself.
The way to do this would be the following:
Option Explicit
Sub test()
Dim jsonObj As Object
Dim jsonResults As String
Dim travelDist As Double
jsonResults = "{""distances"":[[0,97641],[97415,0]],""times"":[[0,4189],[4183,0]],""weights"":[[0.0,5653.726],[5644.176,0.0]],""info"":{""copyrights"":[""GraphHopper"",""OpenStreetMap contributors""]}}"
Set jsonObj = JsonConverter.ParseJson(jsonResults)
travelDist = jsonObj("distances")(1)(2)
Debug.Print travelDist 'the result is printed in the immediate window
End Sub
Finally, I assume that since you've used this before, you know you need to add this JSON parser to your project, as well as a reference to Microsoft Scripting Runtime (VBE>Tools>References>...)
Related
In the same workbook, I've got two worksheets: Model and Results.
My goal is to copy the value of a cell in Model (for e.g., F8) over to a cell in an array (c4 to I23) in Results called ResultsArray (see code below).
When I run my module, no error appears, but the code doesnt seem to work either (the value of F8 doesnt get copied over to the specified cell in ResultsArray).
Appreciate any help.
Tried running different variations of the code below
Sub CopyTest()
Dim ResultsArray As Variant
ResultsArray = Worksheets("Results").Range("C4:I23")
ResultsArray(1, 1) = Worksheets("Model").Range("F8").Value
End Sub
I'm using ResultsArray(1,1) because I am hoping to introduce a loop into the code to populate cells in the array based on the loop counter, e.g., ResultsArray(loopcounter,1)
So turns out I just needed to add "Set" in the 2nd line before "ResultsArray" when assigning the range from the worksheet "Model" to it:
Sub CopyTest()
Dim ResultsArray As Variant
Set ResultsArray = Worksheets("Results").Range("C4:I23")
ResultsArray(1, 1) = Worksheets("Model").Range("F8").Value
End Sub
I've tested this addition and it works
I am developing a VBA / VSTO script that interacts with Outlook.
I have a process that should, essentially, do this:
Read in an .oft file that is in Rich Text Format
Parse the RTFBody array into a String
Replace some elements of the String (so a line that says "%SUBJECT%" will instead be "IMPORTANT MEETING")
Convert that String back into the RTF array format (this uses a Rich Text Box)
Replace the RTFBody with the updated RTF array
Display the finished email
This is all done. Except the finished email is just RTF garbage with no formatting.
So what is meant to be a lovely table is instead this:
{\rtf1\adeflang1025\ansi\ansicpg1252\uc1\adeff37\deff0\stshfdbch0\stshfloch37\stshfhich37\stshfbi37\deflang2057\deflangfe2057\themelang2057\themelangfe0\themelangcs0{\fonttbl{\f0\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}{\f34\fbidi \froman\fcharset0\fprq2{\*\panose 02040503050406030204}Cambria Math;}{\f37\fbidi \fswiss\fcharset0\fprq2{\*\panose 020f0502020204030204}Calibri;}{\f31500\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304
(You can imagine the rest.)
The code is:
Dim objMsg As AppointmentItem
' 1. Read in an .oft file that is in Rich Text Format
objMsg = Application.CreateItemFromTemplate(currentLocation & "\template.oft")
' 2. Parse the RTFBody array into a String
Dim rtfArray = objMsg.RTFBody
Dim Encoding = New System.Text.ASCIIEncoding()
Dim rtfBody = Encoding.GetString(rtfArray)
' 3. Replace some elements of the String (so a line that says "%SUBJECT%" will instead be "IMPORTANT MEETING")
rtfBody = Replace(rtfBody, "%SUBJECT%", "Important Meeting")
' 4. Convert that String back into the RTF array format (this uses a Rich Text Box)
Dim rtb = New System.Windows.Forms.RichTextBox()
rtb.Text = rtfBody
Dim newArray = System.Text.Encoding.ASCII.GetBytes(rtb.Rtf)
'5. Replace the RTFBody with the updated RTF array
objMsg.RTFBody = newArray
'6. Display the finished email
objMsg.Display()
Does anyone have any awareness of what the solution to this problem is?
And before anyone suggests HTML... I would love to! But this is an AppointmentItem so it doesn't support HTMLBody.
To parse the RTFBody array into a string you have dealt with ASCII encoded string:
Dim rtfArray = objMsg.RTFBody
Dim Encoding = New System.Text.ASCIIEncoding()
Dim rtfBody = Encoding.GetString(rtfArray)
But to set the RTFBody you deal with UTF8 for an unknown reason:
Dim newArray = System.Text.Encoding.UTF8.GetBytes(rtb.Rtf)
Try to use the same encoding:
Dim newArray = System.Text.Encoding.ASCII.GetBytes(rtb.Rtf)
Be aware, The Outlook object model supports three main ways of customizing the message body:
The Body property returns or sets a string representing the clear-text body of the Outlook item.
The HTMLBody property of the MailItem class returns or sets a string representing the HTML body of the specified item. Setting the HTMLBody property will always update the Body property immediately. For example:
Sub CreateHTMLMail()
'Creates a new e-mail item and modifies its properties.
Dim objMail As Outlook.MailItem
'Create e-mail item
Set objMail = Application.CreateItem(olMailItem)
With objMail
'Set body format to HTML
.BodyFormat = olFormatHTML
.HTMLBody = "<HTML><BODY>Enter the message text here. </BODY></HTML>"
.Display
End With
End Sub
The Word object model can be used for dealing with message bodies. See Chapter 17: Working with Item Bodies for more information.
Note, the MailItem.BodyFormat property allows you to programmatically change the editor that is used for the body of an item.
I am trying to create a function that allows me to put in a location number and the result will give me a unique location code. The problem is I want all of the referencing done inside of the macro code, not to get the information from somewhere in the spreadsheet. (this code is going into an add-in so there is no worksheet to reference from). I basically want to do a vlookup but inside of the code, not in a worksheet.
I haven't been able to find out how to do this, the code below is something like what I am looking for, I am thinking maybe the use of an array but I can't figure out how to use it the way I want.
I know this doesn't work but I am trying to do something like this below so that when I type in =GetCode(415) the result is 001
Function GetCode(LocationNum As String) As String
Dim Result As String
'Built in reference table
'
'{ "415" : "001"
' "500" : "002"
' "605" : "003"
' }
Dim varData(2) As Variant
varData("415") = "001"
varData("500") = "002"
varData("605") = "003"
Result = varData(LocationNum)
GetCode = Result
End Function
As Nathan_Sav has already mentioned, you can use a collection or dictionary instead, which are much more efficient. Here's an example using the dictionary object. Note that it uses early binding, so you'll need to set a reference to the Microsoft Scripting Runtime library (Visual Basic Editor >> Tools >> Reference).
Option Explicit
Sub test()
'set a reference (VBE >> Tools >> Reference) to the Microsoft Scripting Runtime library
'declare and create an instance of the dictionary object
Dim dic As Scripting.Dictionary
Set dic = New Scripting.Dictionary
'set the comparison mode for the dictionary to a case-insensitive match
dic.CompareMode = TextCompare
'add keys and associated items to the dictionary
dic.Add Key:="415", Item:="001"
dic.Add Key:="500", Item:="002"
dic.Add Key:="605", Item:="003"
'print to the immediate window the item associated with the specified key
Debug.Print dic("415")
'clear from memory
Set dic = Nothing
End Sub
I have been working on a project, and am attempting to make a new array for data. I have tried making an empty array with Dim Name() As String = {}. I am using a ListView, and the way I have done it there are blank spots where I have gotten rid of data. This is my current code:
Sub English(ByVal Country() As String, ByVal Language() As String)
rbDisplayallData.Checked = False
lstResults.Visible = True
lstResults.Items.Clear()
lstResults.Columns.Clear()
With lstResults
.View = View.Details
.Columns.Add("English Speaking Countries", 200, HorizontalAlignment.Left)
End With
For i = 0 To 181
Dim EnglishSpeakingCountries(i) As String
If Language(i) = "English" Then
EnglishSpeakingCountries(i) = Country(i)
End If
lstResults.Items.Add(New ListViewItem({EnglishSpeakingCountries(i)}))
Next
End Sub
I am trying to get rid of these spaces.
I Was thinking if I were to compact the array or make a new one with the same data going into a new array it would fix the issue.
If you have a solution please let me know.
There are two things that could be considered an empty array
An array with no elements, i.e. a Length of zero.
An array where every element is Nothing.
All arrays are fixed-length. Once you create an array with a particular number of elements, it always has that number of elements. You can use ReDim Preserve or Array.Resize but, in both those cases, what actually happens is that a new array is created and the elements copied from the old array. The new array is assigned to the same variable but anywhere the old array is referenced, it will still have that same number of elements. Try running this code to see that in action:
Dim a1 As String() = {}
Dim a2 As String() = {"First", "Second", "Third"}
Dim b1 = a1
Dim b2 = a2
Console.WriteLine(a1.Length)
Console.WriteLine(a2.Length)
Console.WriteLine(b1.Length)
Console.WriteLine(b2.Length)
Console.WriteLine()
ReDim Preserve a1(2)
Array.Resize(a2, 6)
Console.WriteLine(a1.Length)
Console.WriteLine(a2.Length)
Console.WriteLine(b1.Length)
Console.WriteLine(b2.Length)
Console.ReadLine()
Output:
0
3
0
3
3
6
0
3
As you'll be able to see, a1 and a2 end up referring to new arrays with the specified lengths but the original arrays with the original lengths still exist and are still accessible via b1 and b2.
If you start with an array with no elements then you can use ReDim Preserve or Array.Resize to give the appearance of resizing the array but that's not really what's happening and that should generally be avoided. If you know how many elements you'll end up with then you could create an array of that size and then set each element in turn. You'd need to keep track of the next element index though, so that's still a bit tedious.
Generally speaking, if you want an array-like data structure but you want it to be able to grow and shrink as required, you should use a collection. The most common collection is the List(Of T), where T is any type you care to specify in your code. If you want to store String objects then use a List(Of String). You can call Add to append a new item to the end of the list, as well as Insert, Remove and RemoveAt methods. You can also get or set an item by index, just as you can do for array elements.
Note that a List(Of T) actually uses an array internally and uses the aforementioned method of "resizing" that array. It optimises the process somewhat though, which makes the code easier for you to write and large collections more efficient to use.
It's worth noting that, in your own code, the Columns and Items properties of your ListView are both collections, although they are slightly different to the List(Of T) class.
Looking at your original code, this:
For i = 0 To 181
Dim EnglishSpeakingCountries(i) As String
If Language(i) = "English" Then
EnglishSpeakingCountries(i) = Country(i)
End If
lstResults.Items.Add(New ListViewItem({EnglishSpeakingCountries(i)}))
Next
could be changed to this:
Dim englishSpeakingCountries As New List(Of String)
For i = 0 To 181
If Language(i) = "English" Then
englishSpeakingCountries.Add(Country(i))
lstResults.Items.Add(Countries(i))
End If
Next
Note that you're just adding items to two collections. I guess the question is whether you actually need this extra collection at all. If you do want to use it later then you need to assign it to a member variable rather than a local variable. If you don't need it later then don't create it at all. As I said, you're already adding items to a collection in the ListView. Maybe that's all you need, but you haven't provided enough info for us to know.
I have file with tags and targets, this is example:
TAG1|TARGET1,TARGET2
TAG2|TARGET3,TARGET4
I start by creating String Array using File.ReadAllLines
Dim MAIN As String() = File.ReadAllLines("")
At some point I have one of targets and I need to know what was the tag index (which array line is it), so for example if I have TARGET3 I want to know it's in second line so it's in MAIN(1) and then I can grab TAG = TAG2.
I can't get it working, I tried few methods:
Array.IndexOf(MAIN,"TARGET3")
always returned -1, it worked with full string tho,
Array.IndexOf(MAIN,"TAG2|TARGET3,TARGET4")
returned 1. I tried with Array.FindIndex, was the same.
So my question is: how to get index of partial array item. Thank you for any help.
You can use Linq to search your array in this way
Dim search = "TARGET3"
Dim line = MAIN.FirstOrDefault(Function(x) x.Contains(search))
This will return directly the line with the matching word