Background
I need to clear the data since I do not have direct access to the source data. This is an approved activity in my company.
I am not allowed to publish any part of html; however, since I checked a piece of code that is not needed.
I wrote a VBA macro that:
- Opens Internet Explorer
- Going to the intranet site
- Loads a website with cell contents within a single worksheet.
- Processes for accessing customer records
- Search for specific site object identifiers
- Saves values from specific identifiers in a second sheet in the same book
- Frees up memory
- Output
Problem:
- Data will not be saved in the worksheet.
What I tried:
- Create a new worksheet
- Using an Existing Worksheet
- Save, Activate Select
:
:
Option Explicit
Sub GetxyzData()
Dim rowCount As Integer
Dim colCount As Integer
Dim objIE As InternetExplorer
Dim ele As Object
Dim startRange As Range
Dim NoteFound As Boolean
Dim ContactFound As Boolean
Dim itm As Object
'Create the IE Object
Set objIE = CreateObject("InternetExplorer.Application")
'Set the position and size attributes of the IE Object
objIE.Top = 0
objIE.Left = 0
objIE.Width = 800
objIE.Height = 600
'Set the visibility of the IE Object
objIE.Visible = True
'Check to see if there was an error with the website
On Error Resume Next
objIE.navigate ("http://xyz/xyz_Individual/Applications/xyz/SearchMain.aspx/")
'Wait until the website is ready to begin along with error checking
Do While objIE.Busy
DoEvents
'Check to see if there was an error loading the website
If Err.Number <> 0 Then
objIE.Quit
Set objIE = Nothing
GoTo Program_Exit
End If
'Wait until the website is ready to begin
Application.StatusBar = "Connecting to Website..."
DoEvents
Loop
'Set the Row Number to 1 since there is a header row
rowCount = 1
'Set the data entry into Excel in the First Column and row
startRange = "A1"
'Continue to loop through the Excel data until a blank entry is found in the ID Number column
Do While Sheet5.Range("K" & rowCount) <> ""
'Populate the Prospect ID Number in the search box with value in cell "K + Counter"
objIE.document.getElementById("ctl00$txtProspectid").innerText = _
"0" & Sheet5.Range("K" & rowCount).Value
'Click the search button
objIE.document.getElementById("ctl00_btnsearch").Click
'Wait until the website is ready to begin along with error checking
Do While objIE.Busy
Application.StatusBar = "Downloading information, Please wait..."
DoEvents
Loop
'Check to see if this is the first customer and click the appropriate Prospect hyperlink
If rowCount = 1 Then
objIE.document.getElementById("ctl00_GrdExtract_ctl03_btnsel").Click
Else
objIE.document.getElementById("ctl00_GrdMember_ctl03_lnkProspectID").Click
End If
'Wait until the website is ready to begin
Do While objIE.Busy
Application.StatusBar = "Downloading information, Please wait..."
DoEvents
Loop
'Set table type indicators to know when we are processing the 1st data field in each
NoteFound = False
ContactFound = False
'Get the data fields for PII, Contacts and Notes based on the common portion of ID name
With Sheets("MWData")
For Each itm In objIE.document.all
'If it is not a PII, Contact or Note field, then skip it
If itm.ID Like "*ctl00_CPH1_tabcontbottom_tabpnlContact_grdContact*" Or _
itm.ID Like "*ctl00_CPH1_tabcontbottom_tabpnlNotes_GrdUserNotes*" Or _
itm.ID Like "*ctl00_CPH1_tabconttop_TabpnlPI_txt*" Then
'Write itm.Value to screen if it is not blank
If itm.Value <> "" Then
MsgBox itm.Value
End If
' Check to see if it is the first Contact field for the customer, if so save the
' column number the last contact field holds and then increment the rowCounter to store
' the first field of the Note fields.
If itm.ID Like "*ctl00_CPH1_tabcontbottom_tabpnlContact_grdContact*" Then
'If this is the first Contact field then we want to save the the current colCount
If ContactFound = False Then
.Range(colCount & rowCount) = "ContactStart = " & colCount
colCount = rowCount + 1
ContactFound = True
End If
End If
' Check to see if it is the first Note field for the customer, if so save the
' column number the last note field holds
If itm.ID Like "*ctl00_CPH1_tabcontbottom_tabpnlNotes_GrdUserNotes*" Then
'If this is the first Note field then we want to save the the current colCount
If NoteFound = False Then
.Range(colCount & rowCount) = "NoteStart = " & colCount
colCount = rowCount + 1
NoteFound = True
End If
End If
' Store the fields value in the next available column on the same row
Sheets("MWData").Range(colCount & rowCount) = itm.Value
'Increment the column counter to the next to prepare to write the next field
colCount = colCount + 1
End If
Next itm
End With
'Increment the row counter and set the column counter back to 1
rowCount = rowCount + 1
colCount = 1
'Loop back to get the next customer entry
Loop
Application.StatusBar = "Download Complete....."
'Exit the program if there was an error retrieving the website
Program_Exit:
'Clean up system resources before ending the program
objIE.Quit
Set objIE = Nothing
End Sub