VBA getelementsbytagname issue - excel

Good morning,
I'm attempting to extract HTML table information and collate results on en excel spreadsheet.
I'm using the getelementsbytagname("table")(0) function to extract the HTML table info, which has worked well. Can someone please tell me what is the significance of the (0) after the table?
Also, I have an instance where an opened webpage does not have any table information to process (I don't know this until the page is opened), this leads to an error in my code as I try to initialize my data array to the table dimensions. Is there a way of extracting a result from getelementsbytagname("table")(0), I've tried:-
If (iDom.getelementsbytagname("table")(0) = 0) Then
but this returns a run time error.
Many thanks in advance for your help.

First add reference to Microsoft Internet Controls (SHDocVw) and to Microsoft HTML Object Library:
Then the Object Explorer is your friend:
So getElementsByTagName returns IHTMLElementCollection which has property length. When on the page some elements with specific tag name are found then length is greater then zero. HTH
Dim tables As IHTMLElementCollection
Set tables = doc.getElementsByTagName("table")
If tables.Length > 0 Then
Dim table As HTMLTable
Set table = tables.item(0)
' Because item is the default property of IHTMLElementCollection we can simplyfy
Set table = tables(0) ' this is the same as tables.item(0)
End If

In VBA the appended (0) refers to the first element of an array (assuming an Option Base 0). Here is a short example:
vArr = Array("element 1", "element 2", "element 3")
Debug.Print v(1)
The above code should return element 2 as the second element of a zero-based array.
So, getelementsbytagname("table")(0) refers to the first element of that table. Yet, if the "table" is not found then there is no array to get from that table and getting the first element from that array (by appending (0)) yields an error.
Instead you should test if there is actually a table by that name (before trying to access the array of elements within that table) like so:
If (iDom.getelementsbytagname("table") = 0) Then

Related

Can you group shapes as they are created in Excel?

I have a userform in Excel 2016 that will generate a certain group of shapes (a welding symbol, if the context is helpful), mainly consisting of lines, arcs, and textboxes. Some of these will be the same every time the code is run, while others are options to be determined by the user via the userform. At the end those elements are grouped into a single symbol. My current code works as described thus far.
The problem comes when I try to run the form a second time (generating a second group of shapes independent of the first group). I have it set up such that as the code is executed, it creates a shape, names that shape appropriately, then groups all shapes at the end, referring to them by name. The second time the code is run, it uses the same names as in the first run. As soon as it tries to form the second group, I get an error due to names referring to two different shapes.
My question is this: Is there a way to add shapes to a group (or to a collection to be grouped later) as they are created? It seems naming shapes isn't the way to go, as the names are retained after the code ends. I tried referencing by shape index, but since I have images on the page as well, it's hard to determine exactly what a particular shape's index is. I apologize for the lack of code, as I don't have access to it right now. If needed I can write up something simple to get the point across. Any help is greatly appreciated!
You can group shapes with a command like this:
Dim ws as Worksheet
Set ws = ActiveSheet ' <-- Set to the worksheet you are working on
ws.Shapes.Range(Array("Heart 1", "Sun 2", "Star 3")).Group
(you can access the shapes via name or via index). The result of the group command is another shape that is added to the sheet. But be aware that the grouped shapes still exists in the sheet, you can access them with the GroupItems-property.
With ws.Shapes
Dim shGroup As Shape, sh As Shape
Set shGroup = .Range(Array("Heart 1", "Sun 2", "Star 3")).Group
shGroup.Name = "MyNewGroup" & .Count
For Each sh In shGroup.GroupItems
Debug.Print sh.Name, sh.Type
Next sh
End With
As you can see, the single shape elements don't change their names, so grouping would not solve your naming issue. The only way is to add a suffix to the name, e.g. a number (as Excel does it when it creates a shape).
Update: Of course the Array- parameter does not need to be static. You can declare an array that is large enough (it doesn't matter if it contains some empty elements).
Const maxShapes = 12
Dim myShapes(1 to maxShapes) as String
myShapes(1) = *Name of first shape you created*
myShapes(2) = *Name of second shape you created*
...
ws.Shapes.Range(myShapes).Group
or use the Redim command:
Dim myShapes() as String
Redim myShapes(1 to NumberOfShapesInYourNewGroup)
myShapes(1) = *Name of first shape you created*
myShapes(2) = *Name of second shape you created*
...
ws.Shapes.Range(myShapes).Group
To get a unique shape and group name, you can implement various methods. I don't like the attempt with a global variable as they might get reset - for example when you cancel execution during debugging. You could use for example the suffix that Excel generates when you create a new shape. Or put the rename-statement into a loop, put a On error Resume Next before the rename (and don't forget to put an On error Goto 0 after it) and loop until renaming was successfull. Or loop over all shapes in your sheet to find the next free name.
After some trial and error, the solution I came up with is something like the following.
'Count shapes already on sheet
Shapesbefore=ActiveSheet.Shapes.Count
'Create new shapes
'Create array containing indexes of recently created shapes
Dim shparr() As Variant
Dim shprng As ShapeRange
ReDim shparr(Shapestart + 1 To ActiveSheet.Shapes.Count)
For i = LBound(shparr) To UBound(shparr)
shparr(i) = i
Next i
'Group shapes and format weight/color
Set shprng = ActiveSheet.Shapes.Range(shparr)
With shprng
.Group
.Line.Weight = 2
.Line.ForeColor.RGB = 0
End With
This way I don't have to worry about creating and managing various group and shape names, as I don't need to go back and reference them later.

How to access XML response using Excel VBA

I have an excel spreadsheet where I have 25,000+ records with Lat/Lon coordinates and other data. I am trying to use an Excel VBA script to look up an associated County name based on the Lat/Lon using the following US Census web service link (an example coordinate included).
https://geo.fcc.gov/api/census/block/find?latitude=40.000&longitude=-90.000&format=xml
this returns the following response xml.
<Response status="OK" executionTime="0">
<Block FIPS="170179601002012" bbox="-90.013605,39.996144,-89.994837,40.010663"/>
<County FIPS="17017" name="Cass"/>
<State FIPS="17" code="IL" name="Illinois"/>
</Response>
The problem I have is that I need to access the "name" value (i.e.,'Cass', in this case) contained in County node, and this value will be copied into the Excel spreadsheet under the County column. Is there a way to access this value? The XML response is not in the standard form I would expect (I'm new to XML), <County>Cass</County> so I'm unsure how I would access the value I need from this returned response.
The whole XML connection and response part of the script seem to be working fine, I just need to know how get the values from the response for the node in question.
Here is what I have so far. Any help would be greatly appreciated. If you need the full code, let me know.
standard XML connection stuff here...
XmlResponse = oXMLHTTP.responseText
'Process the XML to get County name
strXML = XmlResponse
Set XDoc = New MSXML2.DOMDocument60
If Not XDoc.LoadXML(XmlResponse) Then
Err.Raise XDoc.parseError.ErrorCode, , XDoc.parseError.reason
End If
Set xNode = XDoc.SelectSingleNode("/Response/County")
MsgBox xNode.Text
'Insert County name into Excel
Cells(i + 2, 14).Value = xNode.Text
I am assuming that the xNode.Text part is where I need help in selecting the right part from the response (?).
Many thanks!
An alternative via WorksheetFunction `FilterXML()
If you dispose of Excel vers. 2013+ you can execute the following:
Sub ExampleCall()
Dim myXML As String, myXPath As String
myXML = WorksheetFunction.WebService("https://geo.fcc.gov/api/census/block/find?latitude=40.000&longitude=-90.000&format=xml")
myXPath = "//County/#name"
Debug.Print WorksheetFunction.FilterXML(myXML, myXPath) ' ~> Cass
End Sub
Further hints to FilterXML() and its XPath argument
Starting by a double slash // the XPath string "//County/#name" searches
the <County> node at any hierarchy level returning
the subordinal #name attribute which has to be identified by a leading #. The FilterXML() function returns its textual content.
See FilterXML() function and WebService() function.
Of course it's possible to use both functions directly in worksheet formulae.
In searching around some more today I found a solution to my original question.
For those interested, you can access the County attribute 'name' in the returned xml response and write it out by replacing the above portion of code with the following:
Original:
Set xNode = XDoc.SelectSingleNode("/Response/County")
MsgBox xNode.Text
Updated:
Set xNode = XDoc.SelectSingleNode("//Response/County/#name")
MsgBox xNode.Text

Reference SlicerCache by name, not number

I have some code referencing Slicers:
For Each item In wb.SlicerCaches("Segment").SlicerItems
If item.Selected = True Then
If Len(sSegment) > 0 Then sSegment = sSegment & "|"
sSegment = sSegment & item.Caption
End If
Next item
but I get Invalid procedure call or argument. I've seen many examples referencing them by name, but can't get it to work. If I use (1), (3) etc and then add a slicer, it messes up the order, so the code is mucked up.
How can I reference them by name, my end goal is to iterate through selected items.
You may need to reference the slicercache by adding Slicer_ in front of it.
For example, I added an Authors slicer to a table containing information about books and I could reference it by using this code:
Debug.Print ActiveWorkbook.SlicerCaches("Slicer_Author").Slicers("Author").Caption
The reason I knew to add Slicer_ is because I right clicked the slicer and then selected Slicer Settings... and saw this:
And that seems to reference the slicer fine. It was really dumb luck that I happened to see that and thought to try it.
Try:
For Each item In wb.SlicerCaches.Item("Segment").SlicerItems

populate combobox in VBA with array elements

I have a VBA procedure (in Excel 2007) where I aspire to set the ListFillRange property of a combobox styled as a list using an array.
I know this works if I right click the combobox and write "Sheet1!$F2:$F17" next to the "ListFillRange" property. I can also do this in code. However, I am interested in dynamically setting the value of this property by assigning it an array.
I know for sure the array works as I tested it; there is probably a syntax error here:
ThisWorkbook.Worksheets("Sheet1").OLEObjects("cmbS").ListFillRange = ar
when I do this I get:
"Type mismatch" error.
The result of this action should be that the component is populated with the array elements, from element(0) ... to the last element (n-1) of the array. Any pointers, thank you very much!
I also tried:
ThisWorkbook.Worksheets("Sheet1").cmbS.list = ar
and it says "permission denied"
Here are the combobox properties in case it helps:
After testing and trying, I found this works:
ThisWorkbook.Worksheets("Sheet1").cmbS.ListFillRange = ""
Dim i As Integer
For i = LBound(ar) To UBound(ar)
ThisWorkbook.Worksheets("Sheet1").cmbS.AddItem (ar(i))
Next
However, I am interested in populating with all values at once for faster effect, not just adding element by element.
I know its late but maybe it is going to help someone else. At least the following code works (much faster than element for element) for me.
dim arr() as variant
arr = Worksheets("Total").Range("C2:"&lrow).Value
Worksheets("Menu").ComboBox2.List = arr
The only way you can populate a combobox with the content of an array is by doing it element by element. I find it hard to believe that it would be a notably slow process no matter how large your array is.

Using multiple values field in Lotus Notes

I am trying to write a logging system for a form in Lotus Notes but I am at the part where I am not sure how I can append the information about the fields that are changed in the log fields. There are 3 fields that I use Log_Date (date), Log_User and Log_Actions (Text, allow multiple values).
I thought if I add comma to the log field it will create a new line when displaying the form but I am still getting a type mismatch on the case 2 line.
How can I append the new values to the log fields?
Sub Querysave(Source As Notesuidocument, Continue As Variant)
' Compare the values in the form after it is saved with its original values when the document is not a new document.
Dim doc As NotesDocument
Set doc = Source.Document
Dim session As New NotesSession
Dim user As String
user = session.CommonUserName
If newDoc Then
doc.Log_Date = Now()
doc.Log_User = user
doc.Log_Actions = "New document created."
Else
' Load fields value to the array
lastValues(0) = doc.QCR_No(0)
lastValues(1) = doc.QCR_Mobile_Item_No(0)
lastValues(2) = doc.QCR_Qty(0)
' Compared each value in the array to see if there is any difference
Dim i As Integer
For i = 0 To 2
If lastValues(i) <> originalValues(i) Then
Select Case i
Case 2 : doc.Log_Actions = doc.Log_Actions & "," & "Field QCR_Qty is changed"
End Select
End If
Next
End If
End Sub
doc.Log_Actions returns the notesitem. To access the value you need to use doc.Log_Actions(0)
In LotusScript back-end classes (e.g. NotesDocument, NotesItem), a multi-valued field is represented by an array with one value per element of the array. For setting the value of a field, doc.Log_Actions is shorthand (they call it 'extended syntax' in the Domino Designer help) for assigning the first (i.e., zero subscript) element of the array, but that does not work for getting the value. To get the first value, you have to use doc.Log_Actions(0). To get or set the second value, you have to use doc.Log_Actions(1).
So, your Case 2 code could look like this:
doc.Log_Actions(1) = "Field QCR_Qty is changed"
My guess, however, is that you really want to be able to continually append to the end of the list of values each time this code runs. You are also going to want your code to be robust and not blow up on you if (for any reason!) the Log_Actions item does not exist in the document. For that, you are going to want to do this:
dim actionsItem as NotesItem
if doc.hasItem("Log_Actions") then
set actionsItem = doc.getFirstItem("Log_Actions")
call actionsItem.AppendToTextList("Field QCR_Qty is changed")
end if
Or,
If (Not doc.HasItem("LogActions")) Then
doc.LogActions = "Field QCR_Qty is changed"
Else
doc.LogActions = ArrayAppend(doc.LogActions,"Field QCR_Qty is changed")
End If
This is equivalent to the NotesItem method by rhsatrhs, which you use is matter of preference.

Resources