PDA

View Full Version : Solved: VBA and HTML help make them talk.


vicC
07-13-2010, 12:36 PM
I work in health care environment so everything is very heavy with security. I am not able for what ever reason import data from a table off our intranet. I can view what I think is HTML code. I have copied and pasted the code for the table into notepad. than have copied text from notepad and this make my table very nice. But I have 44 tables that I would have to repeat this every week. I know VBA is very powerful. I can open web page with VBA.
1. Is it possible to have VBA Find the table ID in the source code and copy to text file and than back into wookbook.

2. I am I crazy, no don't answer that.

Here is some of the source code from web page.

<table id="tblMatrix" border="0" cellpadding="2" cellspacing="0" class="matrix">
<colgroup span="1" class="census"></colgroup>
<thead>
<tr>
<th class="census">Census</th>
<th id="thWeekday" colspan="5">Weekdays</th>

<th id="thWeekend" colspan="5">Weekends</th>

</tr>
<tr class="census">
<th class="census" style="border-top-style: none">Level</th>

<th>RN<input name="repeaterSkillWeekday$ctl00$txtId" type="hidden" id="repeaterSkillWeekday_ctl00_txtId" value="1" /></th>

<th>LVN<input name="repeaterSkillWeekday$ctl01$txtId" type="hidden" id="repeaterSkillWeekday_ctl01_txtId" value="2" /></th>

<th>CNA<input name="repeaterSkillWeekday$ctl02$txtId" type="hidden" id="repeaterSkillWeekday_ctl02_txtId" value="4103" /></th>

<th>SIT<input name="repeaterSkillWeekday$ctl03$txtId" type="hidden" id="repeaterSkillWeekday_ctl03_txtId" value="51" /></th>

<th>US<input name="repeaterSkillWeekday$ctl04$txtId" type="hidden" id="repeaterSkillWeekday_ctl04_txtId" value="4" /></th>


<th>RN</th>

<th>LVN</th>

<th>CNA</th>

<th>SIT</th>

<th>US</th>

</tr>
</thead>
<tbody id="bodyMatrix">

<tr>
<td class="census">0</td>

<td>0</td>

<td>0</td>

<td>0</td>

<td>0</td>

<td>0</td>


<td>0</td>

<td>0</td>

<td>0</td>

<td>0</td>

<td>0</td>

</tr>

<tr>
<td class="census">1</td>

<td>2</td>

<td>0</td>

<td>0</td>

<td>0</td>

<td>0</td>


<td>2</td>

<td>0</td>

<td>0</td>

<td>0</td>

<td>0</td>

</tr>

<tr>
<td class="census">2</td>

<td>2</td>

<td>0</td>

<td>0</td>

<td>0</td>

<td>0</td>


<td>2</td>

<td>0</td>

<td>0</td>

<td>0</td>

<td>0</td>

</tr>

<tr>
<td class="census">3</td>

<td>2</td>

<td>0</td>

<td>0</td>

<td>0</td>

<td>0</td>


<td>2</td>

<td>0</td>

<td>0</td>

<td>0</td>

<td>0</td>

</tr>

<tr>
<td class="census">4</td>

<td>2</td>

<td>0</td>

<td>0</td>

<td>0</td>

<td>0</td>


<td>2</td>

<td>0</td>

<td>0</td>

<td>0</td>

<td>0</td>

</tr>

<tr>
<td class="census">5</td>

<td>2</td>

<td>0</td>

<td>0</td>

<td>0</td>

<td>0</td>


<td>2</td>

<td>0</td>

<td>0</td>

<td>0</td>

<td>0</td>

</tr>

This is The code I have been trying. It of course came from the kb here on this site, sorry I do not know BY who. I edited website for security but I know you get the picture. There 130 rows of data in each of the tables if that matters. I will have to find some way of going to the next web page to get the next table. table Id is the same on each web page be cause you have to select things example 7Am shift.... but I can just go start to to webpage that holds each table. This is a Query and I have not been able to make it work just errors off with can not open information.

Sub gethtmltable()
Dim ie As Object
Dim objWeb As QueryTable
Dim sWebTable As String
Set ie = CreateObject("INTERNETEXPLORER.APPLICATION")
With ie
.Visible = False

.Navigate "https://website.net/FacilityScheduler/NorthTexas/DepartmentMatrixView.aspx?id=4217" ' should work for any URL
Do Until .ReadyState = 4: DoEvents: Loop
'You have to count down the tables on the URL listed in your query
'This example shows how to retrieve the 2nd table from the web page.
sWebTable = 14
'Sets the url to run the query and the destination in the excel file
'You can change both to suit your needs
Set objWeb =


.QueryTables.Navigate("https://website.net/FacilityScheduler/NorthTexas/DepartmentMatrixView.aspx?id=4217", _
Destination:=Range("A1"))

With objWeb

.WebSelectionType = xlSpecifiedTables
.WebTables = sWebTable
.Refresh BackgroundQuery:=False
.SaveData = True
End With
End With
Set objWeb = Nothing
End Sub


Thanks for any help, direction, input
and as always your time.
Shred Dude
07-15-2010, 06:35 PM
After navigating to the page you can set an object to contain the table in question and then loop through the cells of the table to extract what you need.

You could do something like:
strURL = "https://website.net/FacilityScheduler/NorthTexas/DepartmentMatrixView.aspx?id=4217"
With IE
.Visible = False 'True
.navigate strURL
While .busy Or .document.readystate <> 4: DoEvents: Wend

Set myTable = .document.getelementbyid("tblMatrix")
While myTable.Rows.Length < 1: DoEvents: Wend
End With

(I found "tblMatrix" in the HTML you provided.)

Then you can build an array of the table's contents and write the array to the sheet.

ReDim data(0)
With myTable
For r = 0 To .Rows.Length - 1
For c = 0 To .rows(r).cells.length-1
strData = strData & .Rows(r).Cells(c).innertext & "|"
Next c
ReDim Preserve data(UBound(data) + 1)
data(UBound(data)) = strData
strData = ""
Next r
End With

Then write the results to the sheet you want it to appear on... Change Activesheet to the sheet reference you need.

'Write Restults to the Sheet
With ActiveSheet.Range("a1").Resize(UBound(data) + 1, 1)
.Value = Application.Transpose(data)
.TextToColumns DataType:=xlDelimited, other:="True", otherchar:="|"
End With



As for going to the separate web pages, you'll just have to change the strURL variable and loop through how many ever you need.
vicC
07-15-2010, 09:31 PM
:bug: That is some great code. I have no Idea how or what it is doing but it is great.:ipray: Worked like that and is very fast! for me. I still have to step through 43 more websites but I think I can, I think can. This is what I ended up withSub datafromweb()
Dim url As String
Dim ie As New InternetExplorer
Dim vtable As Variant
Dim mytable
url = "https://website.net/FacilityScheduler/NorthTexas/DepartmentMatrixView.aspx?id=4217"
Set ie = New InternetExplorer
With ie
.Navigate url
.Visible = True
While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend
Set mytable = .Document.getElementById("tblMatrix")
While mytable.Rows.Length < 1: DoEvents: Wend
End With
ReDim data(0) 'put data in aaray
With mytable
For r = 0 To .Rows.Length - 1
For c = 0 To .Rows(r).Cells.Length - 1
strData = strData & .Rows(r).Cells(c).innerText & "|"
Next c
ReDim Preserve data(UBound(data) + 1)
data(UBound(data)) = strData
strData = ""
Next r
End With
'Write Restults to the Sheet
With Sheet2.Range("a1").Resize(UBound(data) + 1, 1)
'With ActiveSheet.Range("a1").Resize(UBound(data) + 1, 1)
.Value = Application.Transpose(data)
.TextToColumns DataType:=xlDelimited, other:="True", otherchar:="|"
End With

End Sub
Thanks for you time and the code Shred Dude!!!!!!:hi:
Shred Dude
07-16-2010, 09:22 AM
If you set up a sheet in your work book to contain all the URLs, or the unique part of them like the ID code on the end, you could then use that list to loop through all of them with something like this...

Public Sub loopPages()
Dim url As String
Dim rngSites As Range
Dim IDcode As Range

Set rngSites = Sheets("where I keep the list of id codes").Range("codes")

For Each IDcode In rngSites
url = "https://website.net/FacilityScheduler/NorthTexas/DepartmentMatrixView.aspx?id=" & IDcode
DeleteUrlCacheEntry(url)
Call datafromweb(url)
Next IDcode

Set rngSites = Nothing

End Sub

Modify your datafromweb routine to accept the URL as a passed in argument, and then change the last part to add a new worksheet each time for example, or maybe already have a sheet for each ID code already set up and to replace the contents on that sheet whenever you run it.


You'll also want to put this function at the top of the module, and call it before you run the retrieval routine to avoid having a cached version being used. This insures that you actually read the website each time, instead of using the data from the last time it was run.

Public Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" _
(ByVal lpszUrlName As String) As Long

Good luck with it.
vicC
07-16-2010, 09:00 PM
I had already done it my way before checking my email. I will play with your code. I do not understand the function thing yet!!! Do you think that your way would be faster at loading URL. It does sometimes hangs a bit. But I think that maybe my wireless. I will try at work on Monday!! Behind the IRON Curtain of HIPPA. What do you think? I am A Nurse not programmer. Just like this stuff.Sub viclooptest2()

Application.ScreenUpdating = False

Dim url As Variant
Dim sht As Variant
Dim mytable
Dim cell As Range
Dim ie As New InternetExplorer
Set ie = New InternetExplorer
Sheet3.Activate
With Sheet3
.Cells(1, 2).Activate 'Clear sheets of data before bring in new data runs down list of names of tabs
For Each cell In .Range(.Cells(1, 2), .Cells(1, 2).End(xlDown))
sht = cell.Value
Sheets(sht).Cells.Clear
Next cell
End With
With Sheet3
.Cells(1, 2).Activate 'this brings in URL from Sheet and sheet names to place data on
For Each cell In .Range(.Cells(1, 2), .Cells(1, 2).End(xlDown))
sht = cell.Value
url = cell.Offset(0, 1).Value
With ie
.Navigate url
.Visible = True
While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend
Set mytable = .Document.getElementById("tblMatrix")
While mytable.Rows.Length < 1: DoEvents: Wend
End With
ReDim Data(0) 'put data in array
With mytable
For r = 0 To .Rows.Length - 1
For c = 0 To .Rows(r).Cells.Length - 1
strData = strData & .Rows(r).Cells(c).innerText & "|"
Next c
ReDim Preserve Data(UBound(Data) + 1)
Data(UBound(Data)) = strData
strData = ""
Next r
End With
'Write Restults to the Sheet
With Sheets(sht).Range("a1").Resize(UBound(Data) + 1, 1)
'With ActiveSheet.Range("a1").Resize(UBound(data) + 1, 1)
.Value = Application.Transpose(Data)
.TextToColumns DataType:=xlDelimited, other:="True", otherchar:="|"
End With

Sheet3.Activate
Next cell
End With
ie.Quit
Set ie = Nothing
Application.ScreenUpdating = True

End Sub
Thanks again for your time
Shred Dude
07-17-2010, 09:21 AM
Looks like your should work. I made a couple of mods that might help with performance.

In my experience, the For Each loops are often slower than other methods. And if you can minimize the need to read from the sheet, you'll see some improvement. To that end, I set up a Range variable, and read all of our sheetnames and URLs one time into a variable that's held in memory. Then I loop through that list. That might be a touch faster.

Also, instead of clearing all the sheets up front, I consolidated that into the main routine so you clear the contents right before writing the new results. That should eliminate a little time too as you're not reading from the sheet3 so many times to loop through the sheets.

As for using a function, I think your approach will be faster, as you don't need to start and close an instance of internet explorer each time. To do it with a function, you'd want to have the IE variable be public and stay open for the whole routine. Your way is easier.

Let me know if that helps.

Sub viclooptest2()

Application.ScreenUpdating = False

Dim url As Variant
Dim sht As Variant
Dim mytable
Dim cell As Range
Dim ie As New InternetExplorer
Dim rngList As Range, n As Integer

Set ie = New InternetExplorer

'Sheet3.Activate
' With Sheet3
' .Cells(1, 2).Activate 'Clear sheets of data before bring in new data runs down list of names of tabs
' For Each cell In .Range(.Cells(1, 2), .Cells(1, 2).End(xlDown))
' sht = cell.Value
' Sheets(sht).Cells.Clear
' Next cell
' End With

With Sheet3
Set rngList = .Range(.Cells(1, 2), .Cells(1, 3).End(xlDown)) ' Grab both columns
End With
'.Cells(1, 2).Activate 'this brings in URL from Sheet and sheet names to place data on
'For Each cell In .Range(.Cells(1, 2), .Cells(1, 2).End(xlDown))
For n = 1 To rngList.Rows.Count
' sht = cell.Value
' url = cell.Offset(0, 1).Value
sht = rngList(n, 1)
url = rngList(n, 2)

With ie
.Navigate url
.Visible = True
While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend
Set mytable = .Document.getElementById("tblMatrix")
While mytable.Rows.Length < 1: DoEvents: Wend
End With

ReDim data(0) 'put data in array

With mytable
For r = 0 To .Rows.Length - 1
For c = 0 To .Rows(r).Cells.Length - 1
strData = strData & .Rows(r).Cells(c).innerText & "|"
Next c
ReDim Preserve data(UBound(data) + 1)
data(UBound(data)) = strData
strData = ""
Next r
End With

With Sheets(sht)
'Clear the sheet
.UsedRange.ClearContents ' leaves formatting, might be faster than .cells.clear
'Write Results to the Sheet
With .Range("a1").Resize(UBound(data) + 1, 1)
.Value = Application.Transpose(data)
.TextToColumns DataType:=xlDelimited, other:="True", otherchar:="|"
End With
End With
' Sheet3.Activate
Next n

ie.Quit
Set ie = Nothing
Set rngList = Nothing
Application.ScreenUpdating = True

End Sub
Shred Dude
07-17-2010, 09:25 AM
Once you get it working, you might want to try setting the ie.visible property to false. That might speed it up for you too, as then you don't have to wait for the whole page to be rendered in the browser. Your routine will then just happen in the background, like magic!