Access: Compare array variable with string - ms-access

I am trying to compare a value within an array with a text string.
The array is generated by splitting a record containing a string.
Please see the pseudo-code below.
Dim fish As Variant
fish = Split(myRS![Field2], " ")
If fish(Array reference hear?) = "whatever string" Then
'whatever else in hear
End If
I think I am having the following issues – referencing the correct part of the array and then converting the value to a string

If you need only to determine whether one or more of the array elements matches your search text, consider the Filter function.
In this example, Filter returns FishMatched as a one-dimensional array which contains the matching members from the first array (AllFish):
Dim AllFish As Variant
Dim FishMatched As Variant
AllFish = Split(myRS![Field2], " ")
FishMatched = Filter(AllFish, "whatever string")
If UBound(FishMatched) >= 0 Then
Debug.Print UBound(FishMatched) + 1; " match(es) found."
Else
Debug.Print "No match found."
End If
This approach may be suitable if you only need to know whether your search text is present among the members of AllFish. However, since it creates a new array containing the matches, it can not tell you the index of the AllFish member which matched.

You need a for loop to cycle the strings inside your array. LBound and UBound are needed to get the range of your array. You can check inside the loop if theStringYouAreLookingFor Is equal to the value of current array position i
Dim fish As Variant
Dim theStringYouAreLookingFor as String
theStringYouAreLookingFor = "here is what I'm looking for"
fish = Split(myRS![Field2], " ")
For i = LBound(fish) To UBound(fish)
If theStringYouAreLookingFor = fish(i) then
Debug.Print "Found it at " & cstr(i + 1) & " position in array"
Exit for
End If
Next i

Related

How to read json file and take in excel using vba

I have an excel cell value [[{"Name":Ashwin ,"Age":64}],[],[{"Name":Shakur ,"Age":64,"Gender":Male}]]
I need to display the value of gender in cells.
Please find below my code:
Option Explicit
Sub ExampleSplit()
Dim s As String, vx() As String
My_array = Worksheets("sheet1").Cells(1, 1)
vx = Split(My_array, "{")
Array_need = "{" & Split(vx(UBound(vx)), "}")(0) & "}"
Set Jsonobject = JsonConverter.ParseJson(Array_need)
For Each Item In Jsonobject
If Item = "Gender" Then
Worksheets("sheet1").Cells(1, 2) = Item("Gender")
End If
Next
End Sub
After running sucessfuly,value "Male" should be in worksheets("sheet1").cells(1,2).But for me it was throwing "type mismatch"
I wrote PrintJSONAccessors() to answer a similar question: Using VBA and VBA-JSON to access JSON data from Wordpress API. My sub routine prints the proper way to access the json data to the Immediate Window.
The sample code is not valid JSON. It is missing double quotes around its string values.
[[{"Name":Ashwin ,"Age":64}],[],[{"Name":Shakur ,"Age":64,"Gender":Male}]]
This is the valid version:
[[{"Name":"Ashwin" ,"Age":64}],[],[{"Name":"Shakur" ,"Age":64,"Gender":"Male"}]]
Here is how I prepare to extract the JSON data:
Sub Prep()
Dim Data As Variant
Data = Worksheets("sheet1").Cells(1, 1).Value
Set Data = JsonConverter.ParseJson(Data)
PrintJSONAccessors Data, "Data"
Stop
End Sub
I put the Stop in the code so that I can test output in the Immediate Window.
Notice the data is a Dictionary inside a Collection inside another Collection.

VBA: Why isn't my FOR loop returning anything?

The overall goal is to return the characters in between the commas and use each of them in another piece of code. If anyone knows a more optimal way of doing this, please let me know.
The problem:
I am trying to find the positions of the commas in the string.
The string:
Dim st As String
st = "1642377,001642381,010301642379"
My attempt:
For pos = 1 To Len(st)
If Mid(st, pos, 1) = "," Then
MsgBox ("Position of comma:" & pos)
End If
Next
Currently returning:
The code doesn't return anything. The If condition isn't returning true.
Expected result:
A MsgBox should pop up twice, showing the position of the comma each time.
Use the split function. It returns a string array
Dim parts() As String, p As Variant
parts = Split("1642377,001642381,010301642379", ",")
For Each p In parts
Debug.Print p
Next
prints
1642377
001642381
010301642379
You are using 2 different values: st and Me.Text585.Value. Did you mean to use st in the two places? If I do so, the code works and it returns the positions 8 and 18.

JSON Response not reporting properly

I'm using the newtonsoft.dll to deal qwith the proper JSON responses from a site, i have come in to an issue, the delete code:
Dim delPro As String
Dim resPro As String
Dim sB As New StringBuilder()
For Each row As DataGridViewRow In dataGridProjects.Rows
If (row.Cells(4).Value IsNot Nothing) Then
' JSON
delPro = srFunctions.postURL("http://www.ste.com/ajax_task.php?act=add&task=projectDelete", "project_ids=" + row.Cells(0).Value.ToString(), varCookieJar)
resPro = srFunctions.postURL("http://www.ste.com/ajax_task.php?act=status&task=projectDelete", "", varCookieJar)
' purely for debugging
sB.Append("1: " + delPro)
sB.Append(Environment.NewLine + "----------------------------------------------------------------" + Environment.NewLine)
sB.Append("2: " + resPro)
sB.Append(Environment.NewLine + "----------------------------------------------------------------" + Environment.NewLine)
' responses
Dim tempPost = New With {Key .message = "", Key .error = 0, Key .done = False, Key .jsdata = ""}
Dim obj = JsonConvert.DeserializeAnonymousType(resPro, tempPost)
Dim com As String = obj.message
Dim obj2 = JsonConvert.DeserializeObject(Of saperJsonObject)(resPro)
If CBool((CStr(obj2.done))) Then
dataGridProjects.Rows.Remove(row)
Me.returnMessage("Project has been deleted!")
Else
dataGridProjects.Rows.Remove(row)
Me.returnMessage("Site returned an unknown response! (The action still most likely was executed)" & vbCrLf & vbCrLf & "Returned response was: " & (CStr(obj2.done)))
End If
End If
Next
The site returns 2 different success responses, this one:
{"error":0,"done":0,"message":"\u0412\u044b\u043f\u043e\u043b\u043d\u044f\u0435\u0442\u0441\u044f \u0437\u0430\u0434\u0430\u043d\u0438\u0435: 0/1","data":[true,true,0,1]}
Has true,true,0,1 at the end which is a success (the action is still completed) the other one looks like:
{"error":0,"done":1}
or similar, the done:1 also denotes a success, i'm not sure how to look for both success values, i know i need to edit here : If CBool((CStr(obj2.done))) Then but i'm not sure how to go about it.
any help would be great guys!
cheers
Graham
Without a class structure, DeserializeObject is problematic (resPro at least is defined as String). It works, and you can get the done property, but requires Option Strict Off, which is not usually a good idea.
You can also just parse the response if that status is all you need to know.
Public Class Russianobject
<JsonProperty("error")>
Public Property JError As Integer
Public Property done As Boolean
Public Property message As String
Public Property data As Object() ' object array
End Class
This is what the longer message looks like (you didnt post what your saperJsonObject looked like) . I had to change the Error property because it is a reserved word in VB. Also, I changed done from Int32 to Boolean. The last item, data is just an array of objects, and it is not clear which element you need.
Even though the short response does not have all these elements, you can use the same class, message will be empty and datawill be Nothing, so you will have to check!
Dim jstr = from whereever russian objects come from
Dim jobj = JsonConvert.DeserializeObject(Of Russianobject)(jstr)
If jobj.data IsNot Nothing Then
Console.WriteLine("0: {0}, 1: {1}, 2:{2}, 3: {2}", jobj.data(0),
jobj.data(1), jobj.data(2), jobj.data(3))
Else
Console.WriteLine(jobj.done)
End If
This should work whether you get a long or short response. To simply parse it, you do not need a class:
' using the short one:
jstr =...from whereever
jp = JObject.Parse(jstr)
Dim jd = jp.SelectToken("data")
If jd IsNot Nothing Then
Console.WriteLine("0: {0}, 1: {1}, 2:{2}, 3: {2}", jd(0), jd(1), jd(2), jd(3))
Else
Console.WriteLine("done = " & Convert.ToBoolean(jp("done")))
End If
Note that in this case, the property name is used like a key.
Output:
0: True, 1: True, 2:0, 3: 0
done = 1
The long response results in the first, the short results in the second. Whether you use a class and deserialize to an object or simply parse it, you will have to check the data element for Nothing (as shown) since it wont exist in the short response.

Query to parse a field and display it

I have a table with values
Errors:
X_11;SR_4;D_11;SR_2
SR_4;T_22
E_18; E_28; SR_3;
E_28; SR_3;
SR_2;SR_4
I need to put in a query to parse the values so that anything with SR comes up so I do like "*SR*" but in the output I need to display only this:
Errors:
SR_4;SR_2
SR_4
SR_3
SR_3
SR_2;SR_4
I would like this in query with many fields other than this one ... instead of VBA. I am using MS Access 2010, I am guessing some type of parsing with each field being separated with ";" that will only capture SR ones?
I think regular expressions might be a way to go.
In VBA, you need to enable the reference to "Microsoft VBScript Regular Expressions 5.5". This question and its accepted answer has a detailed descrpition on what are Regular Expressions and how to enable them in your project (it's for Excel, but for Access is the same route).
Once you have the reference enabled, this little function will give you a "clean" string:
Public Function filterString(str As String)
Dim re As RegExp, obj As Object, x As Variant, first As Boolean
Set re = New RegExp
With re
.Global = True
.IgnoreCase = True
.MultiLine = False
.Pattern = "SR_[0-9]" ' This will match the string "SR_"
' followed by a digit
End With
filterString = ""
first = True
If re.Test(str) Then
Set obj = re.Execute(str)
For Each x In obj
If first Then
first = False
Else
filterString = filterString & ";"
End If
filterString = filterString & x
Next x
End If
End Function
If you test it you'll see that the result is:
filterString("X_11;SR_4;D_11;SR_2")
SR_4;SR_2
which is the result you want.
Now, a simple select query will give you what you need:
select filterString([Errors]) as err
from [yourTable]
where [yourTable].[Errors] like '*sr*'
Hope this helps
I think you can get what you need by splitting your input string into an array and then using the Filter function to create a second array which includes only the SR_ matches from the first array. Finally Join the second array to produce your output string which contains the matches.
Public Function filterString(ByVal pInput As String) As String
Dim array1() As String
Dim array2() As String
array1 = Split(Replace(pInput, " ", vbNullString), ";")
array2 = Filter(array1, "SR_")
filterString = Join(array2, ";")
End Function
Compared to a regular expression approach, this function is more concise. I find the logic simpler. And it does not require setting a reference.
Notice also it will accommodate SR codes which include more than a single digit (in case that eventually becomes a requirement). For example:
? filterString("X_11;SR_4;D_11;SR_234")
SR_4;SR_234
You could use that function in a query in the same way #Barranka suggested:
SELECT filterString(y.Errors) AS sr_codes
FROM [yourTable] AS y
WHERE y.Errors Like '*sr*';

Retrieve Value Using Key From a Collection in Access 2000

I know this is a simple question but it's aggravating me. If I have a key/value pair in a collection but I can't seem to get the value out using the key. I can get the key using the value but not vice versa. Is there some magical way to accomplish this?
For example:
Dim CycleList As Collection
Dim Value as String
Set CycleList = New Collection
CycleList.Add 1, "Some Value"
Value = CycleList(1)
I've also tried CycleList.Item(1) and it's the same result, Value = 1.
The reason is that you are telling VBA to add an integer 1 with an alternate key of Some Value to the collection. When you call CycleList(1), you are asking for the Item with an index of 1 which happens to be the value 1. The second parameter Some Value represents an alternate key you can use to find the item you want. Here's an example to illustrate:
Public Sub Foo()
Dim bar As Collection
Set bar = New Collection
bar.Add 1, "Blah"
bar.Add "Foobar"
bar.Add 99
Debug.Print "bar(""Blah""): " & bar("Blah")
Debug.Print "bar(1): " & bar(1)
Debug.Print "bar(2): " & bar(2)
Debug.Print "bar(3): " & bar(3)
End Sub
Results when calling Foo in the debug window:
bar("Blah"): 1
bar(1): 1
bar(2): Foobar
bar(3): 99
Note that in the first Debug.Print, I ask for the value by key but in the others, I'm asking for the value by index.