I'm trying to do a XML request through excel vba for one of the internal links (in our company). when i send request and receive response using the code below, i get the following as response text:
[{"CPN":"700-42887-01","ExtractDt":"2018-04-02
00:00:00","Demand":"8645"},"CPN":"700-42887-01","ExtractDt":"2018-04-09
00:00:00","Demand":"8985"},{"CPN":"700-42887-01","ExtractDt":"2018-04-16
00:00:00","Demand":"9341"},{"CPN":"700-42887-01","ExtractDt":"2018-04-23
00:00:00","Demand":"9589"},{"CPN":"700-42887-01","ExtractDt":"2018-04-30
00:00:00","Demand":"9210"},{"CPN":"700-42887-01","ExtractDt":"2018-05-07
00:00:00","Demand":"9698"},{"CPN":"700-42887-01","ExtractDt":"2018-05-14
00:00:00","Demand":"9542"},{"CPN":"700-42887-01","ExtractDt":"2018-05-21
00:00:00","Demand":"9692"},{"CPN":"700-42887-01","ExtractDt":"2018-05-28
00:00:00","Demand":"10416"},{"CPN":"700-42887-01","ExtractDt":"2018-06-04
00:00:00","Demand":"6777"},{"CPN":"700-42887-01","ExtractDt":"2018-06-11
00:00:00","Demand":"12774"},{"CPN":"700-42887-01","ExtractDt":"2018-06-18
00:00:00","Demand":"12912"},{"CPN":"700-42887-01","ExtractDt":"2018-06-25
00:00:00","Demand":"12693"},{"CPN":"700-42887-01","ExtractDt":"2018-07-02
00:00:00","Demand":"12895"},{"CPN":"700-42887-01","ExtractDt":"2018-07-09
00:00:00","Demand":"13366"},{"CPN":"700-42887-01","ExtractDt":"2018-07-16
00:00:00","Demand":"13550"},{"CPN":"700-42887-01","ExtractDt":"2018-07-23
00:00:00","Demand":"7971"},{"CPN":"700-42887-01","ExtractDt":"2018-07-30
00:00:00","Demand":"12442"},{"CPN":"700-42887-01","ExtractDt":"2018-08-06
00:00:00","Demand":"12960"},{"CPN":"700-42887-01","ExtractDt":"2018-08-13
00:00:00","Demand":"14106"},{"CPN":"700-42887-01","ExtractDt":"2018-08-20
00:00:00","Demand":"13543"},{"CPN":"700-42887-01","ExtractDt":"2018-08-27
00:00:00","Demand":"13570"},{"CPN":"700-42887-01","ExtractDt":"2018-09-03
00:00:00","Demand":"13506"},{"CPN":"700-42887-01","ExtractDt":"2018-09-10
00:00:00","Demand":"13914"},{"CPN":"700-42887-01","ExtractDt":"2018-09-17
00:00:00","Demand":"13241"},{"CPN":"700-42887-01","ExtractDt":"2018-09-24
00:00:00","Demand":"13449"}]
I want to extract only the last Value - Namely 13449. What is the code that i need to write to accomplish this.
Thanks in Advance!`
Code used
Sub xmlparsing()
Dim jstring As String
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "**INTERNAL COMPANY LINK HERE**", False
.send
If .Status <> 200 Then Exit Sub
jstring = .responseText
Debug.Print jstring
End With`
End Sub
You could use InStrRev
Mid$(responseText, InStrRev(responseText, ":") + 2, (InStrRev(responseText, "}") - 1) - (InStrRev(responseText, ":") + 2))
InStrRev walks the string from right to left. We know you want the value at the end of the string so this direction is useful. We specify as an argument the character to find. The overall string is the responseText.
The first character to find is ":", from right to left. This will be where you have :"13449"}]. Offset from this + 2 to get the actual start of the value you want, in this case the 1 in 13449.
Same logic to determine end point of string. I use "}" as end point then make an adjustment to move forward to the numbers. Mid allows you to specify a string, start point and number of characters. I pass the arguments to extract the required string to Mid. I used typed functions (with the $ at the end) as more efficient when working with strings.
Considering the fact, that you have already parsed the XML to string, then the easiest fact is to try to slice the string. To see how it works, put the string from .responseText to A1 range and run this:
Sub TestMe()
Dim responseText As String
responseText = Range("A1")
Dim myArr As Variant
myArr = Split(responseText, "Demand"":""")
Debug.Print Left(myArr(UBound(myArr)), Len(myArr(UBound(myArr))) - 4)
End Sub
What it does is to split the string into array by the word Demand":" and to take anything but the last 4 characters of the last unit of the array.
Related
I have a large string (more than 255 char) called strBlockText. This string includes random text and block numbers. The block numbers should to be in the format ###Block####-## (IE: 245Block6533-56) but sometimes someone enters the wrong block number format in the text - for example ##Block####-## or ###Block###-## or ##Block###-##...etc.
**Note, this is for plain text only.
I want to write a function that will be able to state, "Wrong block number format identified." when the block number is fat fingered.
This is the text I'm using as a sample:
This is a Test that we need to figure out why this isn’t working.
24Block1234-23 This is a Test that we need to figure out why this
isn’t working. 245Block4234-14 This is a Test that we need to figure
out why this isn’t working. This is a Test that 245Block6533-56 we
need to figure out why this isn’t working.
This is the code...that I feel should work but isn't:
Dim strBlockText As String
Dim strBlockCheck As String
If (((strBlockText Like "*##Block####-##*") or _
(strBlockText Like "*###Block###-##*") or _
(strBlockText Like "*##Block###-##*")) And _
(Not strBlockText Like "*###Block####-##*")) Then
strBlockCheck = "Wrong block number format identified."
Else
strBlockCheck = "Block number format acceptable."
End If
Would it be better to use a regex for this instead of like?...is there a reason like isn't working?
Consider this Sub using RegExp object with late binding:
Sub testRegExp2(strS)
Dim regexOne As Object, Matches As Object, Match As Object
'Set regexOne = New RegExp
Set regexOne = CreateObject("VBScript.RegExp")
regexOne.Pattern = "[0-9]+Block[0-9]+-[0-9]+"
regexOne.Global = True
Set Matches = regexOne.Execute(strS)
For Each Match In Matches
If Not Match Like "###Block####-##" Then
Debug.Print "Wrong block number format identified: " & Match
Else
Debug.Print "Block number format acceptable: " & Match
End If
Next
End Sub
I'm working on a piece of code to extract the nominal size of a pipeline from it's tagname. For example: L-P-50-00XX-0000-000. The 50 would be it's nominal size (2") which I would like to extract. I know I could do it like this:
TagnameArray() = Split("L-P-50-00XX-0000-000", "-")
DNSize = TagnameArray(2)
But I would like it to be a function because it's a small part of my whole macro and I don't need it for all the plants I'm working on just this one. My current code is:
Sub WBDA_XXX()
Dim a As Range, b As Range
Dim TagnameArray() As String
Dim DNMaat As String
Dim DN As String
Set a = Selection
For Each b In a.Rows
IntRow = b.Row
TagnameArray() = Split(Cells(IntRow, 2).Value, "-")
DN = DNMaat(IntRow, TagnameArray())
Cells(IntRow, 3).Value = DN
Next b
End Sub
Function DNMaat(IntRow As Integer, TagnameArray() As String) As Integer
For i = LBound(TagnameArray()) To UBound(TagnameArray())
If IsNumeric(TagnameArray(i)) = True Then
DNMaat = TagnameArray(i)
Exit For
End If
Next i
End Function
However this code gives me a matrix expected error which I don't know how to resolve. I would also like to use the nominal size in further calculations so it will have to be converted to an integer after extracting it from the tagname. Does anyone see where I made a mistake in my code?
This is easy enough to do with a split, and a little help from the 'Like' evaluation.
A bit of background on 'Like' - It will return TRUE or FALSE based on whether an input variable matches a given pattern. In the pattern [A-Z] means it can be any uppercase letter between A and Z, and # means any number.
The code:
' Function declared to return variant strictly for returning a Null string or a Long
Public Function PipeSize(ByVal TagName As String) As Variant
' If TagName doesn't meet the tag formatting requirements, return a null string
If Not TagName Like "[A-Z]-[A-Z]-##-##[A-Z]-####-###" Then
PipeSize = vbNullString
Exit Function
End If
' This will hold our split pipecodes
Dim PipeCodes As Variant
PipeCodes = Split(TagName, "-")
' Return the code in position 2 (Split returns a 0 based array by default)
PipeSize = PipeCodes(2)
End Function
You will want to consider changing the return type of the function depending on your needs. It will return a null string if the input tag doesnt match the pattern, otherwise it returns a long (number). You can change it to return a string if needed, or you can write a second function to interpret the number to it's length.
Here's a refactored version of your code that finds just the first numeric tag. I cleaned up your code a bit, and I think I found the bug as well. You were declaring DNMAAT as a String but also calling it as a Function. This was likely causing your Array expected error.
Here's the code:
' Don't use underscores '_' in names. These hold special value in VBA.
Sub WBDAXXX()
Dim a As Range, b As Range
Dim IntRow As Long
Set a = Selection
For Each b In a.Rows
IntRow = b.Row
' No need to a middleman here. I directly pass the split values
' since the middleman was only used for the function. Same goes for cutting DN.
' Also, be sure to qualify these 'Cells' ranges. Relying on implicit
' Activesheet is dangerous and unpredictable.
Cells(IntRow, 3).value = DNMaat(Split(Cells(IntRow, 2).value, "-"))
Next b
End Sub
' By telling the function to expect a normal variant, we can input any
' value we like. This can be dangerous if you dont anticipate the errors
' caused by Variants. Thus, I check for Arrayness on the first line and
' exit the function if an input value will cause an issue.
Function DNMaat(TagnameArray As Variant) As Long
If Not IsArray(TagnameArray) Then Exit Function
Dim i As Long
For i = LBound(TagnameArray) To UBound(TagnameArray)
If IsNumeric(TagnameArray(i)) = True Then
DNMaat = TagnameArray(i)
Exit Function
End If
Next i
End Function
The error matrix expected is thrown by the compiler because you have defined DNMaat twice: Once as string variable and once as a function. Remove the definition as variable.
Another thing: Your function will return an integer, but you assigning it to a string (and this string is used just to write the result into a cell). Get rid of the variable DN and assign it directly:
Cells(IntRow, 3).Value = DNMaat(IntRow, TagnameArray())
Plus the global advice to use option explicit to enforce definition of all used variables and to define a variable holding a row/column number always as long and not as integer
I need to pull the code from the following string: 72381 Test 4Dx for Worms. The code is 72381 and the function that I'm using does a wonderful job of pulling ALL the numbers from a string and gives me back 723814, which pulls the 4 from the description of the code. The actual code is only the 72381. The codes are of varying length and are always followed by a space before the description begins; however there are spaces in the descriptions as well. This is the function I am using that I found from a previous search:
Function OnlyNums(sWord As String)
Dim sChar As String
Dim x As Integer
Dim sTemp As String
sTemp = ""
For x = 1 To Len(sWord)
sChar = Mid(sWord, x, 1)
If Asc(sChar) >= 48 And _
Asc(sChar) <= 57 Then
sTemp = sTemp & sChar
End If
Next
OnlyNums = Val(sTemp)
End Function
If the first character in the description part of your string is never numeric, you could use the VBA Val(string) function to return all of the numeric characters before the first non-numeric character.
Function GetNum(sWord As String)
GetNum = Val(sWord)
End Function
See the syntax of the Val(string) function for full details of it's usage.
You're looking for the find function.. Example:
or in VBA instr() and left()
Since you know the pattern is always code followed by space just use left of the string for the number of characters to the first space found using instr. Sample in immediate window above. Loop is going to be slow, and while it may validate they are numeric why bother if you know pattern is code then space?
In similar situations in C# code, I leave the loop early after finding the first instance of a space character (32). In VBA, you'd use Exit For.
You can get rid of the function altogether and use this:
split("72381 Test 4Dx for Worms"," ")(0)
This will split the string into an array using " " as the split char. Then it shows us address 0 in the array (the first element)
In the context of your function if you are dead set on using one it is this:
Function OnlyNums(sWord As String)
OnlyNums = Split(sWord, " ")(0)
End Function
While I like the simplicity of Mark's solution, you could use an efficient parser below to improve your character by character search (to cope with strings that don't start with numbers).
test
Sub test()
MsgBox StrOut("72381 Test 4Dx")
End Sub
code
Function StrOut(strIn As String)
Dim objRegex As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Pattern = "^(\d+)(\s.+)$"
If .test(strIn) Then
StrOut = .Replace(strIn, "$1")
Else
StrOut = "no match"
End If
End With
End Function
i have managed to find a string between 2 specified strings,
the only issue now is that it will only find one and then stop.
how am i possible to make it grab all the strings in a textbox?
the textbox is multiline and i have put a litle config in it.
now i want that the listbox will add all the strings that are between my 2 specified strings.
textbox3.text containts "<"
and textbox 4.text contains ">"
Public Function GetClosedText(ByVal source As String, ByVal opener As String, ByVal closer As String) As String
Dim intStart As Integer = InStr(source, opener)
If intStart > 0 Then
Dim intStop As Integer = InStr(intStart + Len(opener), source, closer)
If intStop > 0 Then
Try
Dim value As String = source.Substring(intStart + Len(opener) - 1, intStop - intStart - Len(opener))
Return value
Catch ex As Exception
Return ""
End Try
End If
End If
Return ""
End Function
usage:
ListBox1.Items.Add(GetClosedText(TextBox1.Text, TextBox3.Text, TextBox4.Text))
The easiest way (least lines of code) to do this would be to use a regular expression. For instance, to find all of that strings enclosed in pointy brackets, you could use this regular expression:
\<(?<value>.*?)\>
Here's what that all means:
\< - Find a string which starts with a < character. Since < has a special meaning in RegEx, it must be escaped (i.e. preceded with a backslash)
(?<value>xxx) - This creates a named group so that we can later access this portion of the matched string by the name "value". Everything contained in the name group (i.e. where xxx is), is considered part of that group.
.*? - This means find any number of any characters, up to, but not including whatever comes next. The . is a wildcard which means any character. The * means any number of times. The ? makes it non-greedy so it stops matching as soon as if finds whatever comes next (the closing >).
\> - Specifies that matching strings must end with a > character. Since > has a special meaning in RegEx, it must also be escaped.
You could use that RegEx expression to find all the matches, like this:
Dim items As New List(Of String)()
For Each i As Match In Regex.Matches(source, "\<(?<value>.*?)\>")
items.Add(i.Groups("value").Value)
Next
The trick to making it work in your scenario is that you need to dynamically specify the opening and closing characters. You can do that by concatenating them to the RegEx, like this:
Regex.Matches(source, opener & "(?<value>.*?)" & closer)
But the problem is, that will only work if source and closer are not special RegEx characters. In your example, they are < and >, which are special characters, so they need to be escaped. The safe way to do that is to use the Regex.Escape method, which only escapes the string if it needs to be:
Private Function GetClosedText(source As String, opener As String, closer As String) As String()
Dim items As New List(Of String)()
For Each i As Match In Regex.Matches(source, Regex.Escape(opener) & "(?<value>.*?)" & Regex.Escape(closer))
items.Add(i.Groups("value").Value)
Next
Return items.ToArray()
End Function
Notice that in the above example, rather than finding a single item and returning it, I changed the GetClosedText function to return an array of strings. So now, you can call it like this:
ListBox1.Items.AddRange(GetClosedText(TextBox1.Text, TextBox3.Text, TextBox4.Text))
I ssume you want to loop all openers and closers:
' always use meaningful variable/control names instead of
If TextBox3.Lines.Length <> TextBox4.Lines.Length Then
MessageBox.Show("Please provide the same count of openers and closers!")
Return
End If
Dim longText = TextBox1.Text
For i As Int32 = 0 To TextBox3.Lines.Length - 1
Dim opener = TextBox3.Lines(i)
Dim closer = TextBox4.Lines(i)
listBox1.Items.Add(GetClosedText(longText, opener , closer))
Next
However, you should use .NET methods as shown here:
Public Function GetClosedText(ByVal source As String, ByVal opener As String, ByVal closer As String) As String
Dim indexOfOpener = source.IndexOf(opener)
Dim result As String = ""
If indexOfOpener >= 0 Then ' default is -1 and indices start with 0
indexOfOpener += opener.Length ' now look behind the opener
Dim indexOfCloser = source.IndexOf(closer, indexOfOpener)
If indexOfCloser >= 0 Then
result = source.Substring(indexOfOpener, indexOfCloser - indexOfOpener)
Else
result = source.Substring(indexOfOpener) ' takes the rest behind the opener
End If
End If
Return result
End Function
BEFORE:
Johnson0, Yvonne
AFTER:
Johnson, Yvonne
String functions for Access can be found at http://www.techonthenet.com/access/functions/string/replace.php
In your example, code like
Replace("Johnson0", "0", "")
will do the trick for the particular string Johnson0. If you need to only remove the zero if it is the last character, play with the additional start and count parameters described in the link above.
You can try executing following query..
UPDATE table set
columnName = REPLACE(columnName,'0','')
WHERE columnName LIKE "%0%";
This will replace all occurrence of "0" with "".
The answer you submitted clarifies your requirement. Based on that, you don't need to create a user-defined function if your Access version is 2000 or later. You can get the same result with the Replace() function.
MsgBox Replace("Jonson0, Yvonne", "0,", ",")
One approach is to create a custom function
See http://www.techonthenet.com/access/functions/misc/alphanumeric.php for an example. You could do something similar, but in the loop you would only keep the alpha characters.
Public Sub xxx()
MsgBox RemoveStr0("Jonson0, Yvonne")
End Sub
Public Function RemoveStr0(sString As String) As String
Dim ipos As Long, sTemp As String
ipos = InStr(1, sString, "0,")
sTemp = Mid$(sString, 1, ipos - 1)
sTemp = sTemp & Mid$(sString, ipos + 1)
RemoveStr0 = sTemp
End Function
if you can pull it out to java or another OO lang you can just do a matching using regexes.