Instantly share code, notes, and snippets.

Embed
What would you like to do?
VBA Script to scrape info from HTML table/input values/div elements
Sub ImportCreditorInfoFromDPP()
'check client_banking_info exists or create it
createClientNoteSheet
'to refer to the running copy of Internet Explorer
Dim ie As InternetExplorer
'New IE instance
Set ie = New InternetExplorer
'to refer to the HTML document returned
Dim html As HTMLDocument
'open Internet Explorer in memory, and go to website
Dim clientId As String
'This is where we are going to get the client ID's from
Dim clientIdListSheet As String
'Grab info for list
clientIdListSheet = ActiveWorkbook.Sheets("Master").Range("B3").Value
'Our DPP prefix
Dim dppUrl As String
'Ser our endpoint
dppUrl = ActiveWorkbook.Sheets("Master").Range("B4").Value
'Dont Show IE working
ie.Visible = False
'Set vars for our loop
Dim i As Integer
Dim clientCount As Integer
clientCount = Worksheets(clientIdListSheet).Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
'Loop through all Id's to get the info
For i = 2 To clientCount
'Set this client ID
clientId = Worksheets(clientIdListSheet).Range("A" & i).Value
'Replace with cell of ID number
ie.navigate dppUrl & "?module=contacts&page=view2&cid=" & clientId
'Wait until IE is done loading page
Do While ie.READYSTATE <> READYSTATE_COMPLETE
Application.StatusBar = "(" & i - 1 & " out of " & clientCount - 1 & ") Pulling data for client " & clientId
DoEvents
Loop
'Check to see if we are authenticated if not then Lets do some Auth!!
If ie.document.Title = "Consumers Legal Aid" Then
'Ask for username and password
Dim username As Variant
Dim password As Variant
'Set username and password vars
username = InputBox("Please Enter Your DPP Userame", "Username")
password = InputBox("Please Enter Your DPP Password", "Password")
'Enter Username and PW into login
ie.document.getElementById("Username").Value = username
ie.document.getElementById("Password").Value = password
ie.document.forms(0).submit
'Wait for login to be complete again
Do While ie.READYSTATE <> 4 Or ie.Busy = True
DoEvents
Loop
End If
'Set our HTML vars
Dim noteslist As HTMLDivElement
Dim note As HTMLObjectElement
Dim currentNote As Integer
'set our html document variables
Dim note_type As String
Dim created_at As String
Dim created_by As String
Dim noteContent As String
'show text of HTML document returned
Set html = ie.document
'We are gonna get our table of creditors
Set noteslist = html.getElementById("notesA")
'Loop through the table and grab dem values!!
For Each note In noteslist.getElementsByClassName("left ml20 w20")
note_type = note.getElementsByTagName("strong")(0).innerText
created_by = note.getElementsByClassName("blue")(0).innerText
created_at = Replace(Replace(Replace(note.innerText, note_type, ""), created_by, ""), Chr(10), "")
noteContent = note.NextSibling.innerText
nextEmptyRow = Worksheets("client_notes").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count + 1
ActiveWorkbook.Sheets("client_notes").Range("A" & nextEmptyRow).Value = clientId
ActiveWorkbook.Sheets("client_notes").Range("B" & nextEmptyRow).Value = note_type
ActiveWorkbook.Sheets("client_notes").Range("C" & nextEmptyRow).Value = created_at
ActiveWorkbook.Sheets("client_notes").Range("D" & nextEmptyRow).Value = created_by
ActiveWorkbook.Sheets("client_notes").Range("E" & nextEmptyRow).Value = noteContent
Next note
Next i
'close down IE and reset status bar
ie.Quit
Set ie = Nothing
Application.StatusBar = ""
End Sub
Enum READYSTATE
READYSTATE_UNINITIALIZED = 0
READYSTATE_LOADING = 1
READYSTATE_LOADED = 2
READYSTATE_INTERACTIVE = 3
READYSTATE_COMPLETE = 4
End Enum
Sub ImportBankingInfoFromDPP()
'check client_banking_info exists or create it
createClientBankingSheet
'to refer to the running copy of Internet Explorer
Dim ie As InternetExplorer
'to refer to the HTML document returned
Dim html As HTMLDocument
'open Internet Explorer in memory, and go to website
Dim clientId As String
'This is where we are going to get the client ID's from
Dim clientIdListSheet As String
'Grab info for list
clientIdListSheet = ActiveWorkbook.Sheets("Master").Range("B3").Value
'New IE instance
Set ie = New InternetExplorer
ie.Visible = False
'Set vars for our loop
Dim i As Integer
Dim clientCount As Integer
clientCount = Worksheets(clientIdListSheet).Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
'Loop through all Id's to get the info
For i = 2 To clientCount
'Set this client ID
clientId = Worksheets(clientIdListSheet).Range("A" & i).Value
'Replace with cell of ID number
ie.navigate "https://cla.debtpaypro.com/index.php?module=contacts&page=view2&cid=" + clientId
'Wait until IE is done loading page
Do While ie.READYSTATE <> READYSTATE_COMPLETE
Application.StatusBar = "Attempting data pull for client " + clientId
DoEvents
Loop
'Check to see if we are authenticated
If ie.document.Title = "Consumers Legal Aid" Then
'Ask for username and password
Dim username As Variant
Dim password As Variant
Dim aTags As New collection
'Set username and password vars
username = InputBox("Please Enter Your DPP Userame", "Username")
password = InputBox("Please Enter Your DPP Password", "Password")
'Enter Username and PW into login
ie.document.getElementById("Username").Value = username
ie.document.getElementById("Password").Value = password
ie.document.forms(0).submit
'Wait for login to be complete again
Do While ie.READYSTATE <> 4 Or ie.Busy = True
DoEvents
Loop
End If
'show text of HTML document returned
Set html = ie.document
'set our html document variables
Dim routingNumber As String
Dim accountNumber As String
Dim accountType As Variant
Dim nameOnAccount As String
Dim nameOfBank As String
'give the vars values
nameOfBank = html.getElementById("bank_name").Value
routingNumber = html.getElementById("routing_num").Value
accountNumber = html.getElementById("account_num").Value
accountType = html.getElementById("account_type").Value
nameOnAccount = html.getElementById("account_name").Value
'Lets see where we are pasting this info
Dim nextEmptyRow As Integer
nextEmptyRow = Worksheets("client_banking_info").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count + 1
'lets place that info into the sheet now
ActiveWorkbook.Sheets("client_banking_info").Range("A" & nextEmptyRow).Value = clientId
ActiveWorkbook.Sheets("client_banking_info").Range("B" & nextEmptyRow).Value = nameOfBank
ActiveWorkbook.Sheets("client_banking_info").Range("C" & nextEmptyRow).Value = routingNumber
ActiveWorkbook.Sheets("client_banking_info").Range("D" & nextEmptyRow).Value = accountNumber
ActiveWorkbook.Sheets("client_banking_info").Range("F" & nextEmptyRow).Value = nameOnAccount
If accountType = 1 Then
ActiveWorkbook.Sheets("client_banking_info").Range("E" & nextEmptyRow).Value = "checking"
Else
If accountType = 2 Then
ActiveWorkbook.Sheets("client_banking_info").Range("E" & nextEmptyRow).Value = "savings"
End If
End If
Next i
'close down IE and reset status bar
ie.Quit
Set ie = Nothing
Application.StatusBar = ""
End Sub
Sub ImportCreditorInfoFromDPP()
'check client_banking_info exists or create it
createClientCreditorSheet
'to refer to the running copy of Internet Explorer
Dim ie As InternetExplorer
'to refer to the HTML document returned
Dim html As HTMLDocument
'open Internet Explorer in memory, and go to website
Dim clientId As String
'This is where we are going to get the client ID's from
Dim clientIdListSheet As String
'Our DPP prefix
Dim dppUrl As String
'Grab info for list
clientIdListSheet = ActiveWorkbook.Sheets("Master").Range("B3").Value
'Ser our endpoint
dppUrl = ActiveWorkbook.Sheets("Master").Range("B4").Value
'New IE instance
Set ie = New InternetExplorer
ie.Visible = False
'Set vars for our loop
Dim i As Integer
Dim clientCount As Integer
clientCount = Worksheets(clientIdListSheet).Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
'Loop through all Id's to get the info
For i = 2 To clientCount
'Set this client ID
clientId = Worksheets(clientIdListSheet).Range("A" & i).Value
'Replace with cell of ID number
ie.navigate dppUrl & "?module=contacts&page=debts&id=" & clientId
'Wait until IE is done loading page
Do While ie.READYSTATE <> READYSTATE_COMPLETE
Application.StatusBar = "Attempting data pull for client " + clientId
DoEvents
Loop
'Check to see if we are authenticated if not then Lets do some Auth!!
If ie.document.Title = "Consumers Legal Aid" Then
'Ask for username and password
Dim username As Variant
Dim password As Variant
'Set username and password vars
username = InputBox("Please Enter Your DPP Userame", "Username")
password = InputBox("Please Enter Your DPP Password", "Password")
'Enter Username and PW into login
ie.document.getElementById("Username").Value = username
ie.document.getElementById("Password").Value = password
ie.document.forms(0).submit
'Wait for login to be complete again
Do While ie.READYSTATE <> 4 Or ie.Busy = True
DoEvents
Loop
End If
'Set our HTML vars
Dim creditorTable As HTMLTable
Dim tr As HTMLTableRow
Dim td As HTMLTableCell
Dim currentRow As Integer
Dim currentCell As Integer
'set our html document variables
Dim creditorName As String
Dim collections As String
Dim account_number As String
Dim account_type As String
Dim current_debt_ammount As String
Dim whose_debt As String
Dim current_payment As String
Dim last_payment As String
Dim notes As String
Dim enrolled As Boolean
Dim nextEmptyRow As Integer
'show text of HTML document returned
Set html = ie.document
'We are gonna get our table of creditors
Set creditorTable = html.getElementById("contactsdebts1")
'Set our row count
currentRow = 1
'Make sure there are rows to loop through
Debug.Print creditorTable.rows.Length
'Loop through the table and grab dem values!!
For Each tr In creditorTable.rows
If currentRow <> 1 And tr.Cells.Length <> 1 Then
currentCell = 1
If tr.Cells.Length > 10 Then
For Each td In tr.Cells
If currentCell = 1 Then
creditorName = td.innerText
ElseIf currentCell = 2 Then
collections = td.innerText
ElseIf currentCell = 3 Then
account_number = td.innerText
ElseIf currentCell = 4 Then
account_type = td.innerText
ElseIf currentCell = 5 Then
current_debt_ammount = td.innerText
ElseIf currentCell = 6 Then
whose_debt = td.innerText
ElseIf currentCell = 7 Then
current_payment = td.innerText
ElseIf currentCell = 8 Then
last_payment = td.innerText
ElseIf currentCell = 9 Then
notes = td.innerText
ElseIf currentCell = 10 Then
enrolled = td.getElementsByTagName("input")(0).Value
End If
currentCell = currentCell + 1
Next td
'Lets see where we are pasting this info
nextEmptyRow = Worksheets("client_creditor_info").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count + 1
'lets place that info into the sheet now
ActiveWorkbook.Sheets("client_creditor_info").Range("A" & nextEmptyRow).Value = clientId
ActiveWorkbook.Sheets("client_creditor_info").Range("B" & nextEmptyRow).Value = creditorName
ActiveWorkbook.Sheets("client_creditor_info").Range("C" & nextEmptyRow).Value = collections
ActiveWorkbook.Sheets("client_creditor_info").Range("D" & nextEmptyRow).Value = account_number
ActiveWorkbook.Sheets("client_creditor_info").Range("E" & nextEmptyRow).Value = account_type
ActiveWorkbook.Sheets("client_creditor_info").Range("F" & nextEmptyRow).Value = current_debt_ammount
ActiveWorkbook.Sheets("client_creditor_info").Range("G" & nextEmptyRow).Value = whose_debt
ActiveWorkbook.Sheets("client_creditor_info").Range("H" & nextEmptyRow).Value = current_payment
ActiveWorkbook.Sheets("client_creditor_info").Range("I" & nextEmptyRow).Value = last_payment
ActiveWorkbook.Sheets("client_creditor_info").Range("J" & nextEmptyRow).Value = notes
ActiveWorkbook.Sheets("client_creditor_info").Range("K" & nextEmptyRow).Value = enrolled
End If
End If
currentRow = currentRow + 1
Next tr
Next i
'close down IE and reset status bar
ie.Quit
Set ie = Nothing
Application.StatusBar = ""
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment