VBA Get XML node value

VBA to get XML node value from a HTML call returning XML.  The example below uses the Zillow API to return XML and extracts the zpid node value from the XML response.  Change "zpid" with the name of the node your trying to grab.

'Enable below reference libraries.

'Microsoft HTML Object Library
'Microsoft XML v3.0

 

'VBA Code
 Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
 Url = http://www.zillow.com/webservice/GetSearchResults.htm?zws-id=X1-ZWz1g14y0hebyj_6h6e1&address=141+2nd+Ave+404&citystatezip=84103
 objHTTP.Open "GET", Url, False
objHTTP.send ("")
 SourceHTMLText = objHTTP.responseText

 SourceHTMLText = objHTTP.responseXML.getElementsByTagName("zpid")(0).FirstChild.NodeValue

Example of XML response:

http://www.zillow.com/webservice/GetSearchResults.htm?zws-id=X1-ZWz1g14y0hebyj_6h6e1&address=141+2nd+Ave+404&citystatezip=84103

<?xml version="1.0" encoding="UTF-8"?>
-<SearchResults:searchresults xmlns:SearchResults="http://www.zillow.com/static/xsd/SearchResults.xsd" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://www.zillow.com/static/xsd/SearchResults.xsd https://www.zillowstatic.com/vstatic/6ce354c/static/xsd/SearchResults.xsd">
<!-- H:011 T:18ms S:1517 R:Mon Jan 01 14:05:45 PST 2018 B:5.0.51000.3-hotfix_2017-12-26_fecb01c.3f62b94~hotfix-platform-for-2017-12-26.2e7029f -->
-<request>
<address>141 2nd Ave 404</address>
<citystatezip>84103</citystatezip>
</request>
+<message>
-<response>
-<results>
-<result>
<zpid>12719246</zpid>

VBA Pull HTML Table into Excel

Excel Macro that will pull all the tables out of a webpage into Excel.  Just put the URL of the webpage in the search box  and click the "PULL Table from Webpage" button.  The VBA will pull HTML Table from webpage into Excel.

VBA Pull HTML Table to Excel Tool (1311 downloads)

 

 

VBA to pull HTML Tables into Excel

VBA is looping all the table tags on the webpage, i.e. <table>, <thead>,<tbody>,<tr>,<th>,<td>, and grabbing the innerHTML of each tag.

Sub PullHTMLTable()
'
' PullHTMLTable Macro
'
Sheets("Data").Select
Range(Cells(7, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count)).Delete

Dim i As Long, strText As String

Dim doc As Object, hTable As Object, hBody As Object, hTR As Object, hTD As Object
 Dim tb As Object, bb As Object, tr As Object, td As Object

Dim y As Long, z As Long, wb As Excel.Workbook, ws As Excel.Worksheet

Set wb = Excel.ActiveWorkbook
 Set ws = wb.ActiveSheet

Dim ie As SHDocVw.InternetExplorer
Set ie = New InternetExplorerMedium
Set ie = CreateObject("InternetExplorer.Application")
 While ie.busy
 DoEvents
 Wend
 ie.Visible = True
 While ie.busy
 DoEvents
 Wend
Dim NavURL As String
NavURL = Cells(3, 3).Value

ie.Navigate NavURL
 While ie.busy
 DoEvents
 Wend
 Set doc = ie.document
 Set hTable = doc.GetElementsByTagName("table")


 y = 2 'Column B in Excel
 z = 7 'Row 7 in Excel
 For Each tb In hTable
 Set hHead = tb.GetElementsByTagName("thead")
 For Each hh In hHead
 Set hTR = hh.GetElementsByTagName("tr")
 For Each tr In hTR
 
 
 Set hTD = tr.GetElementsByTagName("th")
 y = 1 ' Resets back to column A
 For Each th In hTD
 ws.Cells(z, y).Value = th.innertext
 y = y + 1
 Next th
 DoEvents
 z = z + 1
 Next tr
 Exit For
 Next hh
 'Exit For
 
 Set hBody = tb.GetElementsByTagName("tbody")
 For Each bb In hBody
 
 Set hTR = bb.GetElementsByTagName("tr")
 For Each tr In hTR
 
 
 Set hTD = tr.GetElementsByTagName("td")
 y = 1 ' Resets back to column A
 For Each td In hTD
 ws.Cells(z, y).Value = td.innertext
 y = y + 1
 Next td
 DoEvents
 z = z + 1
 Next tr
 Exit For
 Next bb
 z = z + 1
 'Exit For
 Next tb


End Sub

Javascript add Sharepoint List data to HTML page

The script will connect to a Sharepoint List and display the list data values in a html table.

Update with the SP List name: var list = "ContactMgr";

Get Jquery library -> https://cdnjs.com/libraries/jquery.SPServices

<script src="http://ajax.microsoft.com/ajax/jQuery/jquery-1.4.2.min.js" type="text/javascript"></script>
<script src="https://cdnjs.cloudflare.com/ajax/libs/jquery.SPServices/2014.02/jquery.SPServices-2014.02.min.js" type="text/javascript"></script>
<script src="https://cdnjs.cloudflare.com/ajax/libs/jquery.SPServices/2014.02/jquery.SPServices-2014.02.js" type="text/javascript"></script>

<table id="result-table" >
 <thead>
 <tr> 
 <th>Name</th>
 <th>Phone</th>
 <th>Aliases</th>
 </tr>
 </thead>
 <tbody id="tableBody">
 </tbody>
 </table>

<script type=text/javascript>
 getMyListData() ;
 function getMyListData()
 { 
 var method = "GetListItems"; 
 var webURL = $().SPServices.SPGetCurrentSite() ; 
 var list = "ContactMgr"; 
 var fieldsToRead = "<ViewFields>"+"<FieldRef Name='Name' />" +"</ViewFields>";
 var query = "<Query><OrderBy><FieldRef Name='ID' Ascending='True' /></OrderBy></Query>";

$().SPServices
 ({
 operation: method,
 async: false, 
 webURL: webURL,
 listName: list,
 CAMLViewFields: "<ViewFields Properties='True' />",
 CAMLQuery: query, 
 completefunc: function (xData, Status)
 {
 $(xData.responseXML).SPFilterNode("z:row").each(function() 
 {
 
 var NameV = $(this).attr("ows_FullName");
 var PhoneV = $(this).attr("ows_Phone"); 
 var AliasV = $(this).attr("ows_Aliases");

$("#result-table").append("<tr align='middle'>" +
 "<th>"+NameV+"</th>"+
 "<th>"+PhoneV+"</th>" + 
 "<th>"+AliasV+"</th>" +
 "</tr>");
 });
 
 }
 });
 };

</script>

IE VBA working with pop up window

When automating internet explorer it can be tricky when you have to work with pop up windows because VBA doesn't know which IE window to be referencing.  The below VBA lets you designate which window the VBA should be running on.

Update the if statement with my_url = pop up window url or my_title = pop up window title.  Which you can find by right click -> properties.

Set objShell = CreateObject("Shell.Application")
 my_url = ""
 my_title = ""
IE_Count = objshell.Windows.Count
for x = 1 to (IE_count - 1) 
 on error resume next 
 my_url = objShell.Windows(x).document.Location 
 my_title = objShell.Windows(x).document.Title 
 if my_url like "vba-market.com" then 
 set objIE = objShell.Windows(x) 
 Exit For 
 else 
 End if
Next x
On error goto 0

Add new Admin User for wordpress using FTP

Add new Admin User for wordpress using FTP

Add this code to the end of your functions.php file.  It will add a new admin user to your wordpress site in the event you’ve been locked out of your site.

Steps:

  1. Access the files to your website using FTP
  2. Download your functions.php file
  3. Open the file in a text editor
  4. Update the username, password and email
  5. Add below code to the end of the functions.php file
  6. Save file and upload back to your site

function add_admin_acct(){     $login = 'myacct1';     $passw = 'mypass1';     $email = 'myacct1@mydomain.com';     if ( ! username_exists( $login )  && ! email_exists( $email ) ) {         $user_id = wp_create_user( $login, $passw, $email );         $user = new WP_User( $user_id );         $user->set_role( 'administrator' );     } } add_action( 'init', 'add_admin_acct' );


VBA download pdf file from URL

Macro that downloads pdf file to designated folder from URL.

This example shows how to download a pdf from a URL to your computer.  Its very useful when you have a large number of pdf’s you need to download from the internet.

https://www.vba-market.com/DownloadPDF_fromURL.xlsm

Update variable strPDFLink to the URL of the pdf file.

strPDFLink = "https://www.vba-market.com/DownloadPDF_fromURL.pdf"

Update variable strPDFFile to change the name of the file.

strPDFFile = strDir & "\DownloadPDF_fromURL_" & Format(Now, "yyyy.mm.dd") & ".pdf"

Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Function DownloadFile(url As String, LocalFilename As String) As Boolean
    Dim lngRetVal As Long
    lngRetVal = URLDownloadToFile(0, url, LocalFilename, 0, 0)
    If lngRetVal = 0 Then DownloadFile = True
End Function

Sub DownloadPDF()
Dim strPDFLink As String
Dim strPDFFile As String
Dim doc, hcol, text As Variant
Dim ie As SHDocVw.InternetExplorer
Set ie = CreateObject("InternetExplorer.Application")

   MsgBox "Select Folder to Save .pdf to)"
Dim FolderName As String
With Application.FileDialog(msoFileDialogFolderPicker)
   .AllowMultiSelect = False
   .Show

   On Error Resume Next
   strDir = .SelectedItems(1)
   Err.Clear
   On Error GoTo 0
 End With

    strPDFLink = "https://www.vba-market.com/DownloadPDF_fromURL.pdf"
    strPDFFile = strDir & "\DownloadPDF_fromURL_" & Format(Now, "yyyy.mm.dd") & ".pdf"
    ie.Visible = True
    ie.Navigate (strPDFLink)
    Application.Wait (Now + #12:00:02 AM#)
    Result = DownloadFile(strPDFLink, strPDFFile)

End Sub


VBA auto populate web form

Demo how to automatically populate a web form with VBA.

VBA

VBA code which opens the form in the web browser.  Then finds the input boxes by their name and inputs the values into the fields.

https://www.vba-market.com/AutoPopulateForm.xlsm

Option Explicit
Sub PopulateForm()
Dim doc, hcol, text As Variant
Dim ie As SHDocVw.InternetExplorer
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.Navigate ("https://www.vba-market.com/project-form/")
Do While ie.ReadyState <> READYSTATE_COMPLETE
    DoEvents
    Loop
    While ie.Busy
    DoEvents
    Wend

    Set doc = ie.Document
    Set hcol = doc.getElementsByTagName("input")
        For Each text In hcol
            If text.Name = "your-name" Then
                text.Value = "Dylan Gregory"
            End If
        Next
    Set doc = ie.Document
    Set hcol = doc.getElementsByTagName("input")
        For Each text In hcol
            If text.Name = "your-email" Then
                text.Value = "helpdesk@vba-market.com"
            End If
        Next
    Set doc = ie.Document
    Set hcol = doc.getElementsByTagName("input")
        For Each text In hcol
            If text.Name = "project-summary" Then
                text.Value = "Auto Populate Form with VBA"
            End If
        Next
        Set doc = ie.Document
    Set hcol = doc.getElementsByTagName("textarea")
        For Each text In hcol
            If text.Name = "project-detail" Then
                text.Value = "Demo of how to Auto Populate an HTML Form with VBA. "
            End If
        Next
    Set doc = ie.Document
    Set hcol = doc.getElementsByTagName("input")
        For Each text In hcol
            If text.Name = "project-budget" Then
                text.Value = "$200.00 "
            End If
        Next
            Set doc = ie.Document
    Set hcol = doc.getElementsByTagName("input")
        For Each text In hcol
            If text.Name = "date-496" Then
                text.Value = Now
            End If
        Next

End Sub

HTML

Simplified version of the HTML code for the web form.  Key value to look for is either the name of the field or the ID.

 

<html>
<body>
  <form>
    <input name= your-name" value="" />
    <input name="your-email" value="" />
    <input name="project-summary" value="" />
    <textarea name="project-detail" value=""> </textarea>
    <input name="project-budget" value="" />
    <input name="date-496" value="" />
  </form>
</body>
</html>


Excel Macro pull historical stock market data

Excel Macro to pull historical stock market data

Macro that Automatically pulls historical stock market data from Google finance.  Input list of tickers and the macro will go pull the historical data for the specified date range.  Allows you to easily pull all historical data for multiple tickers without having to manually search and download tickers one at a time.


**Note: Looks like Google has decided to block automated queries for historical data.  This may be temporary or permanent not sure.  They have be locking down on their stock market data because companies have been using the data to sell which has ruined the service for everyone looks like.  This is the message from Google after running the Macro.

VBA Pull Stock Prices

  
Sub StockMarketDataDownload()

Application.ScreenUpdating = False
 On Error Resume Next

Dim Loc
 Dim ws, ws2, ws3 As Worksheet
 Dim EndDate, StartDate As Date
 Dim Symbol, qurl As String

'Create worksheets
 Sheets("Tickers").Select
 Set ws = ActiveSheet
 Sheets("Data").Select
 Set ws2 = ActiveSheet
 ws2.Cells.Clear

ws.Select
 StartDate = Range("B2").Value
 EndDate = Range("B3").Value

' Set Range for Loop
 Dim i As Integer
 Dim tickerEnd As Integer
 Cells(5, 1).Select
 Range(Selection, Selection.End(xlDown)).Select
 tickerEnd = Selection.Rows.Count
 tickerEnd = tickerEnd

 Dim j As Integer
 Dim idate As Integer
 Dim iclose As Integer

 'Loop through Column

For i = 2 To tickerEnd
 j = 4 + i

 iclose = i + 1
 idate = 2
 ws2.Cells.Clear
 Range("A1").Select
 ws.Select

Symbol = Cells(j, 1).Value

' ' qurl = "http://www.google.com/finance/historical?q=" & Symbol & "&output=csv"
'https://finance.google.com/finance/historical?cid=304466804484872&startdate=Aug+1%2C+2016&enddate=Oct+1%2C+2017&num=30&ei=QwXRWeCqEYiljAGdiJWoBA
'https://finance.google.com/finance/historical?q=SPY&startdate=Aug+1%2C+2016&enddate=Oct+1%2C+2017&num=30&output=csv
'https://finance.google.com/finance/historical?q=SPY&startdate=Jan+1+2016&enddate=Oct+1C+2017&num=30&output=csv

qurl = "https://finance.google.com/finance/historical?q=" _
& Symbol & "&startdate=" & Format(StartDate, "mmm") & "+" & Day(StartDate) & "+" & Year(StartDate) & _
"&enddate=" & Format(EndDate, "mmm") & "+" & Day(EndDate) & "+" & Year(EndDate) & "&num=30&output=csv"

'MsgBox qurl
 ws2.Select

Query:
 With Sheets("Data").QueryTables.Add(Connection:="URL;" & qurl, Destination:=Sheets("Data").Range("A1"))
 .BackgroundQuery = True
 .TablesOnlyFromHTML = False
 .Refresh BackgroundQuery:=False
 .SaveData = False
 End With

Sheets("Data").Range("A1").CurrentRegion.TextToColumns Destination:=Sheets("Data").Range("A1"), DataType:=xlDelimited, _
 TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
 Semicolon:=False, Comma:=True, Space:=False, other:=False

 'Paste date
 Cells.Select
 Selection.Copy
 Sheets.Add After:=Sheets(Sheets.Count)
 ActiveSheet.Paste
 ActiveSheet.Name = Symbol
 Columns("A:A").Select
 Selection.ColumnWidth = 14.29
 Range("A1").Select

 Next i
Application.ScreenUpdating = True
On Error GoTo 0

ErrorHandler:

End Sub


VBA loop HTML page elements by tag name

How to Loop webpage to find a specific element

This VBA code can be used to loop all the data on a webpage looking for a specific element.  This element can then be actioned.  Such actions as inputting value in text box, clicking button, scraping values, etc.  You have to lookup the name or ID in the HTML so you can tell Excel which element on the page to interact with.

https://www.vba-market.com/IEAutomationExample.xlsm

Sub scrape_loop()
Dim doc, hcol, text As Variant
Dim ie As SHDocVw.InternetExplorer
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.Navigate ("https://www.google.com")
Do While ie.ReadyState <> READYSTATE_COMPLETE
    DoEvents
    Loop
    While ie.Busy
    DoEvents
    Wend
Set doc = ie.Document
Set hcol = doc.getElementsByTagName("input")
    For Each text In hcol
         If text.ID = "lst-ib" Then
              text.Value = "www.vba-market.com"
        End If
    Next
Application.Wait (Now + #12:00:02 AM#)
Set doc = ie.Document
Set hcol = doc.getElementsByTagName("button")
    For Each text In hcol
         If text.ID = "_fZl" Then
              text.Click
        End If
    Next
End Sub

Set hcol = doc.getElementsByTagName("button")

This should be set to the Tag type your looping such as input, button, td, etc.

The macro loops all the tags of the specified type.  You can then check if the name, id, innerHTML, etc of the element matches what you’re looking for.

If text.ID = "lst-ib" Then

If text.title = "Search" then

The ID, name, title, etc can be found in View Source of the webpage (right click inspect element).  Use the select tool to grab the element you’re looking for.

Then read through the HTML code to find the ID, name, title, innerHTML, etc.

search

Set doc = ie.Document
Set hcol = doc.getElementsByTagName("input")
    For Each text In hcol
         If text.ID = "lst-ib" Then
              text.Value = "www.vba-market.com"
        End If
    Next

Then use this to loop the tags to find the input Search box.  Once it is found the value “www.vba-market.com” is input into the Search box.

*Note:  Microsoft Internet Controls Reference must be enabled.


Excel VBA web scraper Google finance

Excel VBA web scraper Google finance

Macro that scrapes web data from Google Finance page.  You input a list of Tickers and run the macro which goes to Google finance and pulls the stats for the list of tickers.

 

Google Finance Web Scraper (99 downloads)

 

Output of macro:

web-scraper-google-finance

Option Explicit
Sub WebScrape()
Dim tickerLength, nextIs, i As Long
Dim doc, hcol, text As Variant
Dim ticker As String
Dim currentInnerHtml As String
currentInnerHtml = ""
Dim ie As SHDocVw.InternetExplorer
tickerLength = WorksheetFunction.CountA(Columns(1))
For i = 2 To tickerLength - 1
ticker = Cells(i + 1, 1).Value
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.Navigate ("https://www.google.com/finance?q=" & ticker)
Do While ie.ReadyState <> READYSTATE_COMPLETE
    DoEvents
    Loop
    While ie.Busy
    DoEvents
    Wend
    Set doc = ie.Document
    Set hcol = doc.getElementsByTagName("td")
        For Each text In hcol

            If currentInnerHtml = "Range" Then
                currentInnerHtml = ""
                If InStr(1, text.innerhtml, "<", vbTextCompare) = 0 And InStr(1, text.innerhtml, "&", vbTextCompare) = 0 Then
                    Cells(i + 1, 2).Value = text.innerhtml
                End If
            ElseIf currentInnerHtml = "52 week" Then
                currentInnerHtml = ""
                If InStr(1, text.innerhtml, "<", vbTextCompare) = 0 And InStr(1, text.innerhtml, "&", vbTextCompare) = 0 Then
                    Cells(i + 1, 3).Value = text.innerhtml
                End If
            ElseIf currentInnerHtml = "Open" Then
                currentInnerHtml = ""
                If InStr(1, text.innerhtml, "<", vbTextCompare) = 0 And InStr(1, text.innerhtml, "&", vbTextCompare) = 0 Then
                    Cells(i + 1, 4).Value = text.innerhtml
                End If
            ElseIf currentInnerHtml = "volavg" Then
                currentInnerHtml = ""
                If InStr(1, text.innerhtml, "<", vbTextCompare) = 0 And InStr(1, text.innerhtml, "&", vbTextCompare) = 0 Then
                    Cells(i + 1, 5).Value = text.innerhtml
                End If
            ElseIf currentInnerHtml = "Mkt" Then
                currentInnerHtml = ""
                If InStr(1, text.innerhtml, "<", vbTextCompare) = 0 And InStr(1, text.innerhtml, "&", vbTextCompare) = 0 Then
                    Cells(i + 1, 6).Value = text.innerhtml
                End If
             ElseIf currentInnerHtml = "PE" Then
                currentInnerHtml = ""
                If InStr(1, text.innerhtml, "<", vbTextCompare) = 0 And InStr(1, text.innerhtml, "&", vbTextCompare) = 0 Then
                    Cells(i + 1, 7).Value = text.innerhtml
                End If
            ElseIf currentInnerHtml = "DivY" Then
                currentInnerHtml = ""
                If InStr(1, text.innerhtml, "<", vbTextCompare) = 0 And InStr(1, text.innerhtml, "&", vbTextCompare) = 0 Then
                    Cells(i + 1, 8).Value = text.innerhtml
                End If
             ElseIf currentInnerHtml = "EPS" Then
                currentInnerHtml = ""
                If InStr(1, text.innerhtml, "<", vbTextCompare) = 0 And InStr(1, text.innerhtml, "&", vbTextCompare) = 0 Then
                    Cells(i + 1, 9).Value = text.innerhtml
                End If
            ElseIf currentInnerHtml = "Shares" Then
                currentInnerHtml = ""
                If InStr(1, text.innerhtml, "<", vbTextCompare) = 0 And InStr(1, text.innerhtml, "&", vbTextCompare) = 0 Then
                    Cells(i + 1, 10).Value = text.innerhtml
                End If
             ElseIf currentInnerHtml = "Beta" Then
                currentInnerHtml = ""
                If InStr(1, text.innerhtml, "<", vbTextCompare) = 0 And InStr(1, text.innerhtml, "&", vbTextCompare) = 0 Then
                    Cells(i + 1, 11).Value = text.innerhtml
                End If
            ElseIf currentInnerHtml = "Inst" Then
                currentInnerHtml = ""
                If InStr(1, text.innerhtml, "<", vbTextCompare) = 0 And InStr(1, text.innerhtml, "&", vbTextCompare) = 0 Then
                    Cells(i + 1, 12).Value = text.innerhtml
                End If
            End If

            If InStr(1, text.innerhtml, "Range", vbTextCompare) > 0 Then
                currentInnerHtml = "Range"
            ElseIf InStr(1, text.innerhtml, "52 week", vbTextCompare) > 0 Then
                 currentInnerHtml = "52 week"
            ElseIf InStr(1, text.innerhtml, "Open", vbTextCompare) > 0 Then
                currentInnerHtml = "Open"
            ElseIf InStr(1, text.innerhtml, "Vol", vbTextCompare) > 0 Then
                currentInnerHtml = "volavg"
            ElseIf InStr(1, text.innerhtml, "Mkt cap", vbTextCompare) > 0 Then
                currentInnerHtml = "Mkt"
            ElseIf InStr(1, text.innerhtml, "P/E", vbTextCompare) > 0 Then
                currentInnerHtml = "PE"
            ElseIf InStr(1, text.innerhtml, "Div/yield", vbTextCompare) > 0 Then
                currentInnerHtml = "DivY"
            ElseIf InStr(1, text.innerhtml, "EPS", vbTextCompare) > 0 Then
                currentInnerHtml = "EPS"
            ElseIf InStr(1, text.innerhtml, "Shares", vbTextCompare) > 0 Then
                currentInnerHtml = "Shares"
            ElseIf InStr(1, text.innerhtml, "Beta", vbTextCompare) > 0 Then
                currentInnerHtml = "Beta"
            ElseIf InStr(1, text.innerhtml, "Inst", vbTextCompare) > 0 Then
                currentInnerHtml = "Inst"
            End If
        Next

Next i
End Sub

*Note: Microsoft Internet Controls Reference must be enabled