VPN Forum access and IP addresse Tests

Some notes in support of these Threads
http://www.eileenslounge.com/viewtopic.php?f=18&t=33775
http://www.eileenslounge.com/viewtop...d7141c#p262009
http://www.excelfox.com/forum/showth...ll=1#post11570
http://www.excelfox.com/forum/showth...ll=1#post11608
http://www.excelfox.com/forum/showth...ll=1#post11803



VPN and IP Addresses
Some of the initial investigations into testing VPN and in looking at problems showed that it was useful to be able to monitor various IP addresses.
The main (Public) address, as already discussed, ( http://www.excelfox.com/forum/showth...ll=1#post11597 ) , is of course important to know . There is also a "local host", which more typically is set to the same number for everyone, (127.0.0.1 ). This is a number which conventionally is used to allow direct access to network aspects of your computer which might otherwise be accessed externally in some way or another. A characteristic of VPN software is that it manipulate your computer in a way such that, amongst other things , this number will change to the internal address used at your VPN provider to identify you within their system. It is part of the trickery in the Client software, that you "looking at yourself" gets manipulated into looking somewhere else. The provider in some ways is then in control of your computer allowing them to give the impression that your computer is physically somewhere else: Part of your computer "Soul" is with them.

Public address
Manually this is achieved typically by visiting various sites that provide you with this information. The automated way still needs to use such sites. The reason for this is that you need to be able to get the information by accessing yourself in the way that another computer connected to the internet "gets at you". Part of this process involves obtaining your public address as you communicate initially with them. We could scrap any site offering the service and pick out the IP address information.
We can simplify the coding to do this by accessing a site available which only gives the IP information, and which shows as the website that you "see" just that IP address number.
So for example if you type in your browser URL bar, http://myip.dnsomatic.com/ , then all you will see is the IP address. You will even see only that if you are in Google Chrome Browser and right click and view the Page Source
Page Source myip dnsomatic .JPG : https://imgur.com/uceUKE4 Attachment 2567
Attachment 2580

This information will be the entire .responseText received back. In normal scrapping coding you might feed this supplied text string into an object model software which allows you to then pick out using OOP type techniques what you want. If we use the site http://myip.dnsomatic.com/ , we don't need to take that extra step, and can simply view the entire .responseText , as this is the exact info we want.

( I found that sometimes the first one or few attemps did not work in the next coding, but almost always after a few attemopts it worked. So the recursion technique is used to call the Function a few times , if necerssary )

Code:

---

Option Explicit
Sub TestPubicIP()
Dim strIP As String
 Call PubicIP(strIP)
 MsgBox prompt:=strIP
 'Call WtchaGot(strIP)
End Sub
' Because we have ByRef PublicIP  , the is effectively taking the variable  strIP  into the function, and similarly in the  recursion Call line  that variable is taken.  Hopefull in one of the 5 attepts at running the Function  it will be filled.. We don't actually fill the pseudo variable  PubicIP  so no value is returned directly by the Function. (So we could have used a Sub()routine instead)  To get a returned value we look at the value in  strIP  after runing the routine , because , as said, hopefully that particular variable will have been added to
Function PubicIP(ByRef PublicIP As String, Optional ByVal Tries As Long) As String
    If Tries = 5 Then Exit Function
 On Error GoTo Bed
    With CreateObject("msxml2.xmlhttp")
    .Open "GET", "http://myip.dnsomatic.com", True ' 'just preparing the request type, how and what type... "The True/False argument of the HTTP Request is the Asynchronous mode flag. If set False then control is immediately returns to VBA after Send is executed. If set True then control is returned to VBA after the server has sent back a response.
    'No extra info here for type GET
    '.setRequestHeader bstrheader:="Ploppy", bstrvalue:="Poo"
    .setRequestHeader bstrheader:="If-Modified-Since", bstrvalue:="Sat, 1 Jan 2000 00:00:00 GMT" '  https://www.autohotkey.com/boards/viewtopic.php?t=9554  ---  It will caching the contents of the URL page. Which means if you request the same URL more than once, you always get the same responseText even the website changes text every time. This line is a workaround : Set cache related headers.
    .send ' varBody:= ' No extra info for type GET. .send actually makes the request
        While .readyState <> 4: DoEvents: Wend ' Allow other processes to run while the web page loads. Think this is part of the True option
    Dim PageSrc As String: Let PageSrc = .responseText ' Save the HTML code in the (Global) variable. ': Range("P1").Value = PageSrc 'For me for a print out copy to text file etc.    The responseText property returns the information requested by the Open method as a text string
    End With
 Let PublicIP = PageSrc: ' Debug.Print PubicIP
 'Call WtchaGot(PubicIP)
    If PublicIP = "" Then Call PubicIP(PublicIP, Tries + 1) ' Recursion Call line. I do this because sometines it seems to need more than one try before it works
Exit Function
Bed:
 Let PubicIP = Err.Number & ":  " & Err.Description: Debug.Print PubicIP
End Function

---

As an alternative , I have below a similar coding. It gets the page source from another site which shows your IP address. I found when looking at the page source in Google Chrome, that I could see the IP address conveniently showing between two simple text lines :
Page Source whatismyipaddress_com .JPG : https://imgur.com/LSvORAe
Attachment 2581

To VBA ( or most computer things), that text looks like a long string, and at that point we can imagine that it looks to the computer like any one of these 3 representations
……. ipt -->" & vbLf & "87" & "." & "101" & "." & "95" & "." & "204" & vbLf & "<!—do not scr……..
…….ipt --> vbLf 87.101.95.204 vbLf <!—do not scr ………….

…….ipt --> vbLf
87.101.95.204 vbLf
<!—do not scr ………….

We apply some simple VBA strings manipulation techniques to extract just the IP address number

Code:

---

'
Sub TestPubicIPwhatismyipaddress_com()
Dim strIP As String
 Let strIP = PubicIPwhatismyipaddress_com
 MsgBox prompt:=strIP
End Sub
Function PubicIPwhatismyipaddress_com() As String
 On Error GoTo Bed
    With CreateObject("msxml2.xmlhttp")
    .Open "GET", "https://whatismyipaddress.com/de/meine-ip", False ' 'just preparing the request type, how and what type... "The True/False argument of the HTTP Request is the Asynchronous mode flag. If set False then control is immediately returns to VBA after Send is executed. If set True then control is returned to VBA after the server has sent back a response.
    'No extra info here for type GET
    '.setRequestHeader bstrheader:="Ploppy", bstrvalue:="Poo"
    .setRequestHeader bstrheader:="If-Modified-Since", bstrvalue:="Sat, 1 Jan 2000 00:00:00 GMT" '  https://www.autohotkey.com/boards/viewtopic.php?t=9554  ---  It will caching the contents of the URL page. Which means if you request the same URL more than once, you always get the same responseText even the website changes text every time. This line is a workaround : Set cache related headers.
    .send ' varBody:= ' No extra info for type GET. .send actually makes the request
        While .READYSTATE <> 4: DoEvents: Wend ' Allow other processes to run while the web page loads. Think this is part of the True option
    Dim PageSrc As String: Let PageSrc = .responsetext ' Save the HTML code in the (Global) variable. ': Range("P1").Value = PageSrc 'For me for a print out copy to text file etc.    The responseText property returns the information requested by the Open method as a text string
    End With
 Let PubicIPwhatismyipaddress_com = PageSrc: ' Debug.Print PubicIPwhatismyipaddress_com
Dim IPadres As String, posIPadres1 As Long, posIPadres2 As Long
 Let posIPadres1 = InStr(1, PageSrc, "<!-- do not script -->", vbBinaryCompare)  '      Screenshot --->  Page Source whatismyipaddress_com .JPG : https://imgur.com/LSvORAe
 Let posIPadres2 = InStr(posIPadres1 + 1, PageSrc, "<!-- do not script -->", vbBinaryCompare)
 Let PubicIPwhatismyipaddress_com = Mid(PageSrc, posIPadres1 + 23, ((posIPadres2 - 1) - (posIPadres1 + 23)))
 Call WtchaGot(PubicIPwhatismyipaddress_com)
Exit Function
Bed:
 Let PubicIPwhatismyipaddress_com = Err.Number & ":  " & Err.Description: Debug.Print PubicIPwhatismyipaddress_com
End Function

---

---

Local Host address and computer name in the next post

Local Host address, Computer name
There are a couple of Win32 APIs which will get this information.
We just need to write a small amount of coding to get the function to do what we want and also a bit of manipulaation to give the information as we need it.
For the computer name this is simply a function to give us a string.

Code:

---

Option Explicit
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, ByRef nSize As Long) As Long
'  "GetComputerNameA" (ByVal lpBuffer As String, ByRef nSize As Long) As Long
Function ComputerName() As String                                                                                                                                                                        ' GHB and sex..
Dim NmeLen As Long, lngX As Long, strCompName As String
 Let NmeLen = 999: Let strCompName = "                                    "    ' variables must be initialised or API things often dont work                                                            ' String$(50, 0)
 Let lngX = GetComputerName(strCompName, NmeLen) '
    If lngX <> 0 Then ' returns 1 if it works
    Let ComputerName = strCompName '  Left$(strCompName, NmeLen)  ' The first argument variable gets like a LSet done on it
    Else
    Let ComputerName = "Couldn't get Computer name"
    End If
 Let ComputerName = Left$(ComputerName, NmeLen) ' We must do this as there is a  Chr(0)  after the name ....  Let ComputerName = Trim(ComputerName) ' this is no good, - it leaves Chr(0) on the end which means that ComputerName is the last thing that will get printed
 'Call WtchaGot(ComputerName)
End Function


---

The Win32 API for the local IP address is slightly more complicated. It will give us a table/ array of all the IP addresses held. The first is generally that we are interested in. it seems to be added when a VPN connection is made

Code:

---

Option Explicit
Private Declare Function GetIpAddrTable_API Lib "IpHlpApi" Alias "GetIpAddrTable" (ByRef pIPAddrTable As Any, ByRef pdwSize As Long, ByVal bOrder As Long) As Long    '  http://www.source-code.biz/snippets/vbasic/8.htm
'  "GetIpAddrTable" (ByRef pIPAddrTable As Any, ByRef pdwSize As Long, ByVal bOrder As Long) As Long
Public Function GetIpAddrTable() As String  '      Christian d'Heureuse, www.source-code.biz  http://www.source-code.biz/snippets/vbasic/8.htm
Rem 1 We give the API function some info , and that seems to make it fill up an array with table values
Dim Buf(0 To 1234) As Byte ' Buf(0 To 511) As Byte ' must be Byte or overflow at NrOfEntries
Dim BufSize As Long: Let BufSize = 12345
Dim rc As Long: Let rc = GetIpAddrTable_API(Buf(0), BufSize, 1)
  'If rc <> 0 Then Err.Raise vbObjectError, , "GetIpAddrTable failed with return value " & rc
Dim NrOfEntries As Integer: NrOfEntries = Buf(1) * 256 + Buf(0)
  'If NrOfEntries = 0 Then GetIpAddrTable = Array(): Exit Function

Dim i As Long
  For i = 0 To NrOfEntries - 1
    Dim j As Long, s As String
      For j = 0 To 3
      Dim Indcy As Long: Let Indcy = 4 + i * 24 + j
      s = s & IIf(j > 0, ".", "") & Buf(Indcy): Debug.Print Indcy & "  " & Buf(Indcy) ' This code line just builds the final string for each IP address, with a "." before all but the first of the 4 number parts  ---  for example like  192 . 168 . 2 . 110
      Next j
    Dim strIPs As String: Let strIPs = strIPs & "  " & s: Let s = ""
    Next
  GetIpAddrTable = strIPs: Debug.Print strIPs
End Function

'    4  127
'    5  0
'    6  0
'    7  1
'    28  192
'    29  168
'    30  2
'    31  110
'      127.0.0.1  192.168.2.110                                                                                          ' _

'    4  10
'    5  132
'    6  13
'    7  113
'    28  127
'    29  0
'    30  0
'    31  1
'    52  192
'    53  168
'    54  2
'    55  110
'      10.132.13.113  127.0.0.1  192.168.2.110
'    1  2  3    4  5  6  7      8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
'    25 26 27  28  29  30  31    32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48
'    49 50 51  52  53  54  55
'              10  132  13  127
'              127  0  0  1
'              192 168  2  110

---

If we examine that coding above, and experiment with what it does, we see a couple of things:
Rem 1
_ It is doing a strange thing, as API's often do. That is to say the API works similarly to a normal VBA function, except the way each argument is a mystery.. following some set of rules/coding which probably the author wrote when he was drunk and no one can remember anymore.
You must make an array of Byte types. The array should be fairly big.
You must give the first array element and the size of the array to the API Function.
Then magically the array gets filled. Presumably some internally held table is put into the array
Rem 2
A bit of maths is done to pick out the elements we want from the returned filled array

The final analysis here of a typical output can be helpful to try and understand another way to get this information

Code:

---

'    1  2  3    4  5  6  7      8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
'    25 26 27  28  29  30  31    32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48
'    49 50 51  52  53  54  55
'              10  132  13  127
'              127  0  0  1
'              192 168  2  110

---

Or maybe not. I am not sure. I doubt many people are…

[FONT=Arial][size=3] [color="#3E0000"]



Using Windows Management Instrumentation (WMI)
Why?

iiziuziuziuzkgjgjhhggjjg

4, 5, 6 and 7 data section output after running Sub SpltTests() from http://www.excelfox.com/forum/showth...0881#post10881
https://tinyurl.com/yd95w5v2

_____ Workbook: Sample.xlsm ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G	H
41	40	1416		80	1456		120	1496
42	S1	S2		S1	S2		S1	S2
43	121	1497		161	1537		201	1577
44	122	1498		162	1538		202	1578
45	123	1499		163	1539		203	1579
46	124	1500		164	1540		204	1580
47	125	1501		165	1541		205	1581
48	126	1502		166	1542		206	1582
49	127	1503		167	1543		207	1583
50	128	1504		168	1544		208	1584
51	129	1505		169	1545		209	1585
52	130	1506		170	1546		210	1586
53	131	1507		171	1547		211	1587
54	132	1508		172	1548		212	1588
55	133	1509		173	1549		213	1589
56	134	1510		174	1550		214	1590
57	135	1511		175	1551		215	1591
58	136	1512		176	1552		216	1592
59	137	1513		177	1553		217	1593
60	138	1514		178	1554		218	1594
61	139	1515		179	1555		219	1595
62	140	1516		180	1556		220	1596
63	141	1517		181	1557		221	1597
64	142	1518		182	1558		222	1598
65	143	1519		183	1559		223	1599
66	144	1520		184	1560		224	1600
67	145	1521		185	1561		225	1601
68	146	1522		186	1562		226	1602
69	147	1523		187	1563		227	1603
70	148	1524		188	1564		228	1604
71	149	1525		189	1565		229	1605
72	150	1526		190	1566		230	1606
73	151	1527		191	1567		231	1607
74	152	1528		192	1568		232	1608
75	153	1529		193	1569		233	1609
76	154	1530		194	1570		234	1610
77	155	1531		195	1571		235	1611
78	156	1532		196	1572		236	1612
79	157	1533		197	1573		237	1613
80	158	1534		198	1574		238	1614
81	159	1535		199	1575		239	1615
82	160	1536		200	1576		240	1616
83	S1	S2
84	241	1617
85	242	1618
86	243	1619
87	244	1620
88

Worksheet: Result

Main Routine in support of these Threads Part 1
http://www.excelfox.com/forum/showth...0893#post10893
http://www.eileenslounge.com/viewtopic.php?f=21&t=31572

The coding is split into 2 parts to fil it into a Forum Post. But this and the coding in the next post form a single routine. That forms the main routine. In addition, a routine Called by the Main routine is required, Public Sub GetElemsText( ) , which is posted in the over next post.

Code:

---

Option Explicit
Sub EP() '    http://www.excelforum.com/showthread.php?t=1148621&page=7&p=4452110&highlight=#post4452110
Rem 1)File Info
'Dim wsLkUp As Worksheet: Set wsLkUp = ThisWorkbook.Worksheets("Tabelle1"): wsLkUp.Activate
Dim strURL As String ' File with Page ' file:///G:/Excel0202015Jan2016/OffenFragensForums/eileenslounge/XP/Updates/report.html
Let strURL = ThisWorkbook.Path & "\Updates\" & "report.html" ' '"http://www.ernaehrung.de/lebensmittel/de/W233000/Fleischkaese.php" ' "http://www.ernaehrung.de/lebensmittel/de/W233000/PloppyPooFukYou"
' Application.Wait Now + TimeValue("00:00:02") '
Rem 2) '
'2a  xmlHTTP stuff  MSXML2.XMLHTTP.6.0    IXMLHTTPRequest  Alan: "simple xml request here, so you could give URL a simple File of the HTML code"      'Dim Request As Object: Set Request = CreateObject("MSXML2.XMLHTTP") 'Late Inding                    https://msdn.microsoft.com/en-us/library/ms759148(v=vs.85).aspx
Dim request As MSXML2.XMLHTTP:  Set request = New MSXML2.XMLHTTP 'Early Binding Requires --- TOOLS --- REFERENCES -- tick Microsoft XML, v6.0    http://www.mrexcel.com/forum/excel-questions/759592-help-createobject-msxml2-xmlhttp-macro.html
'Application.Cursor = xlWait'cursor disable..just to be on the safe side???
  With request '(or With CreateObject("msxml2.xmlhttp"))'By virtue of GET this is a simplified "xml" request
    .Open bstrmethod:="GET", bstrURL:=strURL, varasync:=True '  ("GET", strURL, True) 'just preparing the request type, how and what type. The second argument determines type. This may then require further info in next lines    Only diferrence to pike's and Kyle's opening and sending stuff is argument:- Leith: "The True/False argument of the HTTP Request is the Asynchronous mode flag. If set False then control is immediately returns to VBA after Send is executed. If set True then control is returned to VBA after the server has sent back a response. I prefer to use asynchronous mode and test if my timeout period has expired to prevent the code from hanging due to an unresponsive server. In the example I provided I used synchronous mode to reduce the amount the code and keep it easier to understand."
    'No extra info here for type GET    '                      '  '.setRequestHeader "DNT", "1"
    '.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" ' Content-Type is the property name, x-www-form-urlencoded is the value (content type in the html is "text/html" not "x-www-form-urlencoded" - that is something diifferent) You can have different request header properties and pass different values. This isn't unusual, just not required in this case  When you POST data to a server, you need to tell it what format you are sending it in. So the Type of Content sent in the body of the request (the send bit) is application/x-www-form-urlencoded
    .setRequestHeader bstrheader:="Ploppy", bstrvalue:="Poo"
    .send ' varBody:= ' No extra info for type GET. .send actually makes the request
        While .readyState <> 4: DoEvents: Wend ' Allow other processes to run while the web page loads. Think this is part of the True option
  Dim PageSrc As String: Let PageSrc = .responseText ' Save the HTML code in the (Global) variable. ': Range("P1").Value = PageSrc 'For me for a print out copy to text file etc.    The responseText property returns the information requested by the Open method as a text string
  End With
Set request = Nothing ' This section is finished. We no longer need the Library. Optionally can therefore Set request = Nothing, a step most appropriate if required for some reason. Previous arguments of good practice to prevent memory leaks and data corruption appear outdated in favour of only using when a good reason is apparent to avoid masking when it is a good idea.
'_..EP2ab Explicit Pedantry.  We intend using PagrSrc through a method to produce a model  Object Orientated stylio for later use through  use of its Methods and Properties. This model is frequently referred to as a Document Orientated Model, DOM. Some steps in this creation of the "DOM" can frequently be confused with the processes in '2a which are in fact now finished. Part of the .Send , "finishes all processes. We move on to '2b. Only PagrSrc is required to be "taken over" as it were
'2b DOM stuff' Make OOP type model of HTML code, using Microsoft HTML Office Library
'Dim HTMLdoc As HTMLDocument: Set HTMLdoc = New HTMLDocument 'Early binding - will not work with .Write:- Leith "This is a case where late binding has to be used. The htmlfile is an ActiveX object that is a wrapper function for the IHTMLDocument2 interface in MSXML2. This gets into a lot of low level system operation......."  https://www.mrexcel.com/forum/excel-questions/367030-copy-table-website-into-excel-vba-2.html#post4031122    https://www.excelforum.com/excel-programming-vba-macros/1214789-late-binding-2.html#post4820307    'Early binding TOOLS >>> REFERENCES >>Microsoft HTML Object Library
Dim HTMLdoc As Object: Set HTMLdoc = CreateObject("htmlfile") 'Late Binding, ' Create an empty HTML Document.
 HTMLdoc.Open 'EP2b(i)  This clears the values in the HTMLdoc. Complete Explicit Pedantry. in usage outside VBA, Methods for an instance will often be required which require a clearing of an instance before "using". Approximately in VBA this can be considered putting the DOM back to as if it were at the point just before it is given "loaded" with the PageSrc String. Effectively in VBA doing a pair of Set = Nothing , with either a Dim  and Create Dom or Set = New type code line  It serves no purpose usually in VBA. Effectively we reset a situation back to as it is. It can however be used through .Open
 HTMLdoc.Write PageSrc 'EP2b(ii).  Convert the HTML code into an HTML Document Object Model, DOM 'give it somehow the info it needs to work further? ---- Fills the DOM HTML  .. Wiki Dom  http://www.excelforum.com/showthread.php?t=1148621&page=3#post4441761
 'HTMLdoc.body.innerHTML = PageSrc ' Most people do that, but The Write method of an HTML file is designed to convert the page source text into an HTML DOM document. Both methods achieve the same results. The more common way Body of the Page Source code when converting it to an HTML DOM document oustside of VBA. Withiin VBA it just works harder to achieve the same. This excludes the Meta data, Java scripts, and Class information from being converted. Generally speaking, this information is not used when retrieving only text data from a web page.
 HTMLdoc.Close 'EP2b(iii)  _ 2 b or not in 2b , that was the ??  http://www.excelforum.com/showthread.php?t=1148621&page=6.. Briefly When used outside VBA, some processes started by .Open() can  or should be finished after the corresponding outside VBA .write(). This is done using .Close(). Once again this can be used in VBA through .Close.  It has no conceivable merit or known as yet reason to use it in VBA. Pike thinks it It closes the document you have just written. As such he describes it as optional. He would also not have the HTMLdoc.Open. Kyle thinks nothing is open. Leith uses it but has made no comment to Date. This may be just his style, like my EP's just not including the HTMLdoc.Open 'EP2b(i)
Rem 3
Rem 3a) Directly

---

Part 2 of Main code.
This coding in this post should be copied diretly under the coding from the last post. Together they form a single routine, the Main routine

(The routine, Public Sub GetElemsText( ) , which is posted in the next post is also required for the Main routine to work )

Code:

---

Rem 3a) Directly
'
'
'    Simple text file print out using just result of  PageSrc  from '2a
    Debug.Print PageSrc ' unfortunately you will unlikely be able to view the whole String as it appears too big. Also pasting to a cell will not make it all visible. However if after pasting the .value from the cell is put in a string and that used in place of Pagesrc in the creation of the DOM it does work, so indicating that the data is there, but just not possible for us to "see".
    Dim strTextFile As String: Let strTextFile = ThisWorkbook.Path & "\Updates\strTextFile.txt"
    Dim HghWyNo2 As Long: Let HghWyNo2 = FreeFile(RangeNumber:=1)
    Open strTextFile For Binary As #HghWyNo2
    Put #HghWyNo2, 1, PageSrc '  Use Put to write the whole array at once  http://www.vb-helper.com/howto_read_write_binary_file.html  https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/put-statement
    Close HghWyNo2
'
'
'
'Application.Cursor = xlDefault' Restore the cursor to normal.
Rem 3b) Large Object from main made OOP type model object, (HTMLdoc)    ( Rem 3b)(i) )          ' Dim Head As Object
'Dim Head As IHTMLElementCollection 'requires Early Binding. getElementsBy___ returns a NodeList which is an interface to the DispHTMLElementCollection which is an internal class that you're not supposed to see/use. It does implement the IHTMLElementCollection though so you can use that.
Dim Head As Object ' Unusually this Large main Object is Dim ed as an Object, ..as you find you cannot Dim it as what its TypeName( ) returns ( or as displayed in the Watch Window ), “DispHTMLElementCollection“ .
 Set Head = HTMLdoc.getElementsByTagName("Table") 'This Object is a massive thing again with loads in, but this time it would appear to be the things "tagged" with < table >  < /table > which look like the headings of each table I am interested in
Rem 4)(Rem 3b)(ii)) Often we would loop here for each "Table" but in our example we only have one
'Dim oTable  As THMLTable ' If we had Early binding, then this would work, because omehow  Head  has been recognised as a table  oTable as HTMLTable.JPG : https://imgur.com/R309JjC , and for ..._
Dim oTable  As Object ' _... this table we have typically present in the object  ' HTML TableRow count , "column" Count for final Table will need to be calculated, "HTML Cell" count in Entire Table
Dim C As Long, r As Long 'Indicies for getting appropriate Row and HTMLTableCell
'Dim n As Long ' Not needed if only one table so only "1 Loop"
'4b)=== main working would be Outer loop for each Table in many similar routines==============Building Array from HTML Table
'For n = 0 To Head.Length - 1 ' We only have one table so don't need to loop. The word Length in HTML things is often similar to what Count is in many VBA objects
 Set oTable = Head(0) ' Somehow  Head  has been recognised as a table  oTable as HTMLTable.JPG : https://imgur.com/R309JjC
'4b(i) Fill variable for dimensions variable for each, one on our case, Main loop
Dim rowCnt As Long: Let rowCnt = oTable.Rows.Length  ' "length" / number of rows in this table
Dim colCt As Long:  Let colCt = oTable.Cells.Length 'In this object the cells "length" would appear to be the number / count of cells in the entire table
Dim colCnt As Long: Let colCnt = Application.WorksheetFunction.RoundUp((colCt / oTable.Rows.Length), 0) ' 'This rounds up to the nearest avarage row width, that is to say column number in a row  '  I thought this did ? colCt \ oTable.Rows.Length
Dim Data() As String 'Array with string element used for output table. Fixed (static) String type for Text.
    ReDim Data(0 To rowCnt - 1, 0 To colCnt - 1) 'Output Array, reDimed to table being looked at. ( Hopefully always same column number, might want to hard Code to  rowCnt, 11 columns . Because I am using "base" of indicie to start at 0 then I go from 0 to one less than the Count(Length)
'4b(ii)  Looping through rows to build output array-----------|
'---Inner loop does at each row, ....
        For r = 0 To rowCnt - 1 'Going along the HTML Table rows exactly as pike ' https://www.mrexcel.com/forum/excel-questions/367030-copy-table-website-into-excel-vba.html#post4026613
'--- .... 'go through each Cell( "column" )  in that row.
            For C = 0 To colCnt - 1 'Going along the HTML Table Cells (columns) exactly the same as pike
'4b(ii)a Build Output Array
            Call GetElemsText(oTable.Rows(r).Cells(C), Data(r, C))  'Data(r, c) = oTable.Rows(r).Cells(c).innerText '  pike, kyle type alternative to calling sub
'4b(ii)b "post processing last column of unified units. ' Probably bad place to put this, other than Speed.. checking / changing units
'                If C = .....
'
'                Else
'                End If
            Next C
'--- .... 'go to next "Cell" in that table row (next Column we "see" in the table row)
        Next r
'---  'Go to next row in this table----------------------------|
'4b(ii)c  Output from Array
 Let Range("A1").Resize(UBound(Data(), 1) + 1, UBound(Data(), 2) + 1).Value = Data()
 Columns("A:Z").AutoFit
'Next n 'go back with a new item, n in large collection Object(item) to get next object within and start checking that one out.
'Go to the next table====
Set HTMLdoc = Nothing ' If done then  when we no longer need it
End Sub '

---

This is required for the single Main routine which is posted in two parts in the last two posts


[Code]'2 Alan http://www.excelforum.com/showthread.php?t=1148621&page=3#post4441761
'5 Leith Ross http://www.mrexcel.com/forum/excel-questions/367030-copy-table-website-into-excel-visual-basic-applications-2.html#post4031122
'10 '....' "This is a recursive procedure to extract text from between an element's start tag and end tag and everything in between. Usually the Calling program will have passed a HTML code ( either from, for example, a .HTML File, a .Tex File, a .txt file, or from a returned such file after a request to a web page) into a Document Object Model. ( DOM ). This somehow organises things in a tree type structure , approximately as like you might see if you carefully indented the HTML code yourself, such that tag pairs were clear to see within tag pairs, each level down as it were. ( a "next level down" is often referred to as a "Child" ). The exact structure is less obvious, but in any case the DOM will have some ordered structure and every constitute part of the code is referred to as an Element. In a simple case most Elements have a start and stop pointed bracket. They are all nodes. Text is usually squeezed in between somewhere within a paired tag set, but is also referred to as a node.
'12 'I think a node is a point, usually a junction point in the tree type structure. Usually before the procedure is run a first time, an Element will have been obtained from the DOM and this is to be passed in the signature line of the procedure, as an Object. VBA then makes a Copy of the procedure and runs that with the given Element.
'15 'The macro will examine this Element Object brought in for a Text Node: If the element .NodeType is not 3 (a text node) then there are possibly child nodes ( Nodes "next down" in a Tree type listing ) that need to examined. The procedure then "Calls itself". In other words the first Copy stops at the Call Point. At the Call point another Copy of the procedure is made and runs in a loop for each child node.
'20 'The next Copy of the macro will again examine the element for a Text Node. If found (If element node type is 3), the text is concatenated with the ElemText String. If this is the ElemText string is empty then ElemText is set to this value. If not then this value is concatenated with any previous text and separated by a tilde character. This character can be used later to parse the text string into the individual strings from each element. The macro will exit the Sub at this point. When this happens, this copy of the macro is "removed from the call stack", in other words it Ends, and the last Copy continues from the Call point at which it was stopped.
Public Sub GetElemsText(ByRef Elem As Object, ByRef ElemText As String) 'It takes an Object, (variable Elem), a HTML Element, or a ( child ) node thereof. (Wiki says "An HTML element is an individual component of an HTML document or web page, once this has been parsed into the Document Object Model. (DOM). HTML is composed of a tree of HTML Elements and other nodes, such as text nodes." May be close to but not excactly what you se by carefully indenting down "Child" levels
'25 Dim strobjElem As String: Let strobjElem = TypeName(Elem)' http://www.excelforum.com/excel-programming-vba-macros/1149427-vba-determine-object-type-from-html-dom-object-put-type-in-string-variable-as-shown-in.html
65 Rem 1) Do we have an Element
70 If Elem Is Nothing Then GoTo LEndSub [color=darkgreen]'If the Object Elem is empty, or rather we are not given one, Then we End

Post to support this Thread:
http://www.excelfox.com/forum/showth...0888#post10888
_1) This part of Rick’s solution
Evaluate(Replace(Replace("IF(ISNUMBER(0+SUBSTITUTE (SUBSTITUTE(A2:A#,"" "",""""),"","","""")),IF(LEFT(A1:A@,4)=""2018"",TR IM(A1:A@&"" ""&A2:A#),""""),IF(LEFT(A1:A@,4)=""2018"",A1:A@,"" ""))", "#", LastRow + 1), "@", LastRow))

I have seen something similar to this before, but it is lost to mankind hidden down in the comment section of a Blog site, Allen Wyatt’s I think…… so its nice that something like this has seen the light of day here…

Quote:

---

Originally Posted by Rick Rothstein

If I am not mistaken, this non-looping macro should also work...

Code:

---

Sub ThisShouldWork()  Dim LastRow As Long  LastRow = Cells(Rows.Count, "A").End(xlUp).Row  Range("A1:A" & LastRow) = Evaluate(Replace(Replace("IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A2:A#,"" "",""""),"","","""")),IF(LEFT(A1:A@,4)=""2018"",TRIM(A1:A@&"" ""&A2:A#),""""),IF(LEFT(A1:A@,4)=""2018"",A1:A@,""""))", "#", LastRow + 1), "@", LastRow))  Range("A1:A" & LastRow).SpecialCells(xlBlanks).EntireRow.Delete End Sub

---

---

To help simplify the explanation, lets take it that we know our range , ( http://www.excelfox.com/forum/showth...-row#post10870 ) so we have LastRow = 40
Two arbitrarily chosen characters, @ and # , are being used to enter into the main formula the LastRow or LastRow +1
Pseudo like we are doing this sort of thing
Replace( “A#” , “#” , “40” ) in order to end up with like “A40”
By inspection of the main formula, and with a bit of eye straining you can probably see where you replace those @ and # with 40 and 41
Just to be sure , running this will get you a nice copy able version of the main formula in the immediate window , ( after running you Hit Ctrl+g from the VB Editor to get the immediate window up):

Code:

---

Sub ThisShouldWork()
Dim LastRow As Long, strEval As String
 Let LastRow = Cells(Rows.Count, "A").End(xlUp).Row
 Let strEval = Replace(Replace("IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A2:A#,"" "",""""),"","","""")),IF(LEFT(A1:A@,4)=""2018"",TRIM(A1:A@&"" ""&A2:A#),""""),IF(LEFT(A1:A@,4)=""2018"",A1:A@,""""))", "#", LastRow + 1), "@", LastRow)
 'Range("B1:B" & LastRow).FormulaArray = "=" & strEval
 Debug.Print strEval  'IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A2:A41," ",""),",","")),IF(LEFT(A1:A40,4)="2018",TRIM(A1:A40&" "&A2:A41),""),IF(LEFT(A1:A40,4)="2018",A1:A40,""))

---

That did work.JPG : https://imgur.com/01sQ91X

_._______________________-
Before moving on a useful note: It is always useful when developing these formulas to view the string in the Immediate window: That can help with tricky syntaxes : The formula seen on the Immediate window must look like a formula in the same syntax as you would manually type it into a cell. So you can see immediately if you get something wrong , such as an error in the finally seen quotes.
_.__________________________
So we have our final formula:
IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A2:A41," ",""),",","")),IF(LEFT(A1:A40,4)="2018",TRIM(A1:A4 0&" "&A2:A41),""),IF(LEFT(A1:A40,4)="2018",A1:A40, ""))
The way these formulas appear to work within the Evaluate(“ “) appears to be tapping into an along the columns , down a row, then along the columns… type updating raster to update a worksheet. The available output then seems to be that which encompasses the deepest and widest ranges. It is a ,little bit more complicated than that ( http://www.excelfox.com/forum/showth...on-and-VLookUp ) , but for our formula we have nice regular equally sized ranges so we are expecting an output of 1 “wide” and 40 “deep”. So for analysis purposes, we can reduce the formula to 40 similar ones.

Lets take the example of the formula for the 13th “down” output ..
IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")),IF(LEFT(A13,4)="2018",TRIM(A13& " "&A14),""),IF(LEFT(A13,4)="2018",A13,""))
Clearly we need to look at this data to see what that formula will do, because this data is used in that formula
_____ Workbook: NormanOrrinRickFilter.xlsm ( Using Excel 2007 32 bit )

Row\Col	A
13	2018, 1, 90709, 10020009, P4, Blabla og Blalala (NY), CHE, Blabla,Bla-ah,
14	10006098, 15392.64

Worksheet: Rick

We have some nested IFs , and I find it is always a good idea to break those down so that we can start doing them as Excel or VBA would do them, that is to say from the middle working outwards. I tend to do this in a text editor with a horizontal scroll bar, or in the VB Editor window
Formula in VB Editor as comment.JPG : https://imgur.com/3cjyqSR

So this is what we have, broken down into the constituent IF sections.
( It may be better to copy this and view in your VB Editor in a wide window. I am working from the bottom , upwards )

Code:

---

' IF( ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")), IF(LEFT(A13,4)="2018" , TRIM(A13" "&A14) , "") , IF( LEFT(A13,4)="2018" , A13 ,"" ) )
' IF( ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")),IF(LEFT(A13,4)="2018",TRIM(A13" "&A14),"") , IF(LEFT(A13,4)="2018",A13,"") )
' IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")),IF(LEFT(A13,4)="2018",TRIM(A13" "&A14),""),IF(LEFT(A13,4)="2018",A13,""))

---

Examining the first line , I can evaluate the two innermost IFs and reduce the formula to

Code:

---

' IF( ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")), TRIM(A13" "&A14) , A13 )
' IF( ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")), IF(LEFT(A13,4)="2018" , TRIM(A13" "&A14) , "") , IF( LEFT(A13,4)="2018" , A13 ,"" ) )

---

I will now evaluate some of those SUBSTITUTEs
( Excel Substitute, seems to work similarly to VBA Replace )

Code:

---

' IF( ISNUMBER(0+1000609815392.64), TRIM(A13" "&A14) , A13 )
' IF( ISNUMBER(0+SUBSTITUTE(10006098,15392.64),",","")), TRIM(A13" "&A14) , A13 )

---

( I am guessing that 0+ will ensure that a number will not be mistaken as a text )

For the case of the 13th “down” formula the final steps in the evaluation go as follows

Code:

---

' 2018, 1, 90709, 10020009, P4, Blabla og Blalala (NY), CHE, Blabla,Bla-ah, 10006098, 15392.64
' TRIM(A13" "&A14)

' IF( True , TRIM(A13" "&A14) , A13 )

---

Here are all the steps together again

Code:

---

' 2018, 1, 90709, 10020009, P4, Blabla og Blalala (NY), CHE, Blabla,Bla-ah, 10006098, 15392.64
' TRIM(A13" "&A14)

' IF( True , TRIM(A13" "&A14) , A13 )


' IF( ISNUMBER(0+1000609815392.64), TRIM(A13" "&A14) , A13 )
' IF( ISNUMBER(0+SUBSTITUTE(10006098,15392.64),",","")), TRIM(A13" "&A14) , A13 )

' IF( ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")), TRIM(A13" "&A14) , A13 )
' IF( ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")), IF(LEFT(A13,4)="2018" , TRIM(A13" "&A14) , "") , IF( LEFT(A13,4)="2018" , A13 ,"" ) )


' IF( ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")), IF(LEFT(A13,4)="2018" , TRIM(A13" "&A14) , "") , IF( LEFT(A13,4)="2018" , A13 ,"" ) )
' IF( ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")),IF(LEFT(A13,4)="2018",TRIM(A13" "&A14),"") , IF(LEFT(A13,4)="2018",A13,"") )
' IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")),IF(LEFT(A13,4)="2018",TRIM(A13" "&A14),""),IF(LEFT(A13,4)="2018",A13,""))

---

The final result will appear in the 13th down position of the 40 “deep” array final results for the entire formula evaluation.
If you can view that last summary on a wide window, it should be able to see how the differing results for the other 39 results are achieved from the formula
Just to make clear once again what seems to go on in these sort of Evaluate formulas, in the next post is a table showing the actual Evaluateions done by VBA

_._____

_2 The final part of Rick’s solution is
Range("A1:A" & LastRow).SpecialCells(xlBlanks).EntireRow.Delete
This uses the VBA SpecialCells Method to get at the cells with nothing in them. Those are then deleted
Explanation:
VBA SpecialCells Method ( https://www.mrexcel.com/forum/excel-...onditions.html , https://docs.microsoft.com/en-us/off...e.specialcells ) returns you a range object ( that range object must not be contiguous ( connected ) cells ) consisting of those cells meeting a specific characteristic. We can choose from a number of characteristics. Here we choose xlBlanks , which refers to the characteristic of the cell being empty. So, if we applied that .SpecialCells(xlBlanks) to this range:.._

Row\Col	B
9
10
11	2018, 1, 90515, 10024515, G9, SBlabla (HQ), CHE, BLABLA, blabla, 10012098, 12003.5
12	2018, 1, 90629, 10022334, P3, BLABLA blabla (blablabla), CHE, BLABLA,blabla, 10033609, 13941.72
13	2018, 1, 90709, 10020009, P4, Blabla og Blalala (NY), CHE, Blabla,Bla-ah, 10006098, 15392.64
14
15	2018, 1, 90765, 10012123, P4, Ch of Blabla(Blabla of Blabla), CHE, BLA-BLA,Bla Blabla, 10005678, 16231.7

_ … then the returned range from that would be Range(“B9:B10,B14”).
If we then apply .Delete to that range then those cells are removed. If you remove a cell via .Delete then initially there is a real hole, like a “black hole” that can’t really exist in a spreadsheet. So Excel might explode or implode, or you would be sucked into that hole , never to return!!! To prevent that happening, Excel shifts all cells to close that hole, ( and adds a new virgin cell at the bottom or right side to fill the indent there caused by the shift. The default Delete option for the direction of that shift is in our case upwards. Hence after applying the .Delete after applying .SpecialCells(xlBlanks) to the above range, ( pseudo like doing something this Range(“B9:B10,B14”).Delete(Shift:=xlUp) ) we will be left with

Row\Col	B
9	2018, 1, 90515, 10024515, G9, SBlabla (HQ), CHE, BLABLA, blabla, 10012098, 12003.5
10	2018, 1, 90629, 10022334, P3, BLABLA blabla (blablabla), CHE, BLABLA,blabla, 10033609, 13941.72
11	2018, 1, 90709, 10020009, P4, Blabla og Blalala (NY), CHE, Blabla,Bla-ah, 10006098, 15392.64
12	2018, 1, 90765, 10012123, P4, Ch of Blabla(Blabla of Blabla), CHE, BLA-BLA,Bla Blabla, 10005678, 16231.7
13
14

What has happened there is the following: Those empty cells ( which were yellow ) have been removed. Other cells have been shifted up to fill up the “holes” created by the removal
( Rick’s code line actually deletes the EntireRow of that row on which the empty cells are found )

_.______________________________________________

Just to make clear once again what seems to go on in these sort of Evaluate formulas, in the next post is a table showing the actual Evaluateions done by VBA

Continued from last post

In a range evaluate type code line like the one we are considering, Excel VBA seems to do the following ( simplified ) ( refs *** )

Excel will have an output "window" ( this could be considered as an output table or output array ). The dimensions of this will be that rectangle that allows all used ranges in the formula to be fitted in,
There are some complicated ways in which Excel handles the situation of ranges of varying size, ( http://www.excelfox.com/forum/showth...on-and-VLookUp ) but for a simpler case of all ranges having the same size, ( in terms of "width" and "depth" ) , as we have, Excel VBA will "expand" its "output window" to this sort of thing:

Excel VBA will do its normal "along the columns, down a row, along the columns…" type thing, in any "Evaluation run". In our case this will mean that it does an evaluation at each row, going down the rows. This is what Excel VBA does in order to fill that last window of cells, ( I am just showing the first 7 of 40 similar formulas as the full list is to big to fit in a forum post )

=IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A2," ",""),",","")),IF(LEFT(A1,4)="2018",TRIM(A1&" "&A2),""),IF(LEFT(A1,4)="2018",A1,""))

=IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A3," ",""),",","")),IF(LEFT(A2,4)="2018",TRIM(A2&" "&A3),""),IF(LEFT(A2,4)="2018",A2,""))

=IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A4," ",""),",","")),IF(LEFT(A3,4)="2018",TRIM(A3&" "&A4),""),IF(LEFT(A3,4)="2018",A3,""))

=IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A5," ",""),",","")),IF(LEFT(A4,4)="2018",TRIM(A4&" "&A5),""),IF(LEFT(A4,4)="2018",A4,""))

=IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A6," ",""),",","")),IF(LEFT(A5,4)="2018",TRIM(A5&" "&A6),""),IF(LEFT(A5,4)="2018",A5,""))

=IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A7," ",""),",","")),IF(LEFT(A6,4)="2018",TRIM(A6&" "&A7),""),IF(LEFT(A6,4)="2018",A6,""))

=IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A8," ",""),",","")),IF(LEFT(A7,4)="2018",TRIM(A7&" "&A8),""),IF(LEFT(A7,4)="2018",A7,""))

Excel VBA will effectively make 40 formulas and place in the "output window" the result of the evaluation of those formulas
The full demo code in the next post includes a code line to put in all 40 formulas in an arbitrary 40 "deep" x 1 "wide" range ("J5:J44")






refs ***
http://www.excelfox.com/forum/showth...age3#post10201