Don: Here are 4 more examples of macros
1) HTML files have tables and forms. Here is an example of using both.
I
first check my dump or HTML source for the wrods table and form. tables
and
forms is the easiest methods to use.
Sub GetZipCodes()
ZIPCODE = InputBox("Enter 5 digit zipcode : ")
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
URL = "
http://zip4.usps.com/zip4/citytown_zip.jsp"
'get web page
IE.Navigate2 URL
Do While IE.readyState <> 4
DoEvents
Loop
Do While IE.busy = True
DoEvents
Loop
Set Form = IE.document.getElementsByTagname("Form")
Set zip5 = IE.document.getElementById("zip5")
zip5.Value = ZIPCODE
Set ZipCodebutton = Form(0).onsubmit
Form(0).submit
Do While IE.busy = True
DoEvents
Loop
Set Table = IE.document.getElementsByTagname("Table")
Location = Table(0).Rows(2).innertext
IE.Quit
MsgBox ("Zip code = " & ZIPCODE & " City/State = " & Location)
End Sub
2) Here is code that unloads a tble very simply. You can find the table
number by counting the number of teh table in the source code. Table is
an
array that starts with an index of zero. I sometimes record a macro in
excel
and then before a new WEBquery and use the index number from the webquery
to
create my VBA code. the table number in a webquery start at zero and I
have
to adjuct the number by 1
Sub WebQuery()
URL = "
http://sg.finance.yahoo.com"
'use BN4.SI
StockName = InputBox("Enter Stock Initials : ")
Request = "/q/hp?s="
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
'get web page
IE.Navigate2 URL & Request & StockName
Do While IE.readystate <> 4
DoEvents
Loop
Do While IE.Busy = True
DoEvents
Loop
Set Table = IE.document.getelementsbytagname("Table")
RowCount = 1
For Each Row In Table(23).Rows
Colcount = 1
For Each cell In Row.Cells
MyStr = cell.innertext
For i = 1 To Len(MyStr)
Range("A" & RowCount) = Mid(MyStr, i, 1)
Range("B" & RowCount) = Asc(Mid(MyStr, i, 1))
RowCount = RowCount + 1
Next i
Cells(RowCount, Colcount) = cell.innertext
Next cell
RowCount = RowCount + 1
Next Row
End Sub
3) I had a request to execute JAVA code from VBA. The request was to
translate sentences on a spradsheet from one language to a second language
using the Google Java script. I didn't know how to run Java so I asked
the
requestor to generate a webpage. I ask for a webpage with an input box, a
translate box, and a submit button. Below is the TEXt file he sent which
I
save on my PC as a HTML and the macro I generated. The HTML code is very
simple since it was hand gerated. HTLM from software like Frontpage is
much
more complicated. Put the HTML code is a HTML file. the put the macro in
an
xls file. change the path name in the macro of the HTML file as required.
This code used ID and a URL as a file on the PC instead of the Internet.
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"
http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="
http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
<title>Google Translate API</title>
</head>
<body>
<form name="f" id="f" action="#" onsubmit="translate(); return false;">
<textarea name="foreign_text" id="foreign_text" rows="4"
cols="60"></textarea>
<br />
<br />
<input type="submit" id="submit_button" value="Translate into English"
onfocus="this.blur();" />
<br />
<br />
<textarea name="translation" id="translation" rows="4" cols="60"
onfocus="this.select();" readonly="true"></textarea></form>
<br />
<script type="text/javascript" src="
http://www.google.com/jsapi"></script>
<script type="text/javascript">
google.load("language", "1");
function translate() {var
originaltext=document.forms["f"].foreign_text.value;
google.language.translate(originaltext, "", "en", function(result) {
document.forms["f"].translation.value = (result.error)?("Error:
"+result.error.message):result.translation; }); }
</script>
</body>
</html>
Sub translate()
Dim objIE As Object
Dim strServAcct As String
URL = "c:\temp\working\translation.html"
'Open Internet Explorer
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate URL
Do While IE.Busy = True Or IE.readystate <> 4
DoEvents
Loop
Set ForeignCells = Range("A1:B1")
For Each cell In ForeignCells
Set ForeignText = IE.document.getElementById("foreign_text")
Set submit = IE.document.getElementById("submit_button")
ForeignText.innertext = cell.Value
submit.Select
submit.Click
Do While IE.Busy = True Or IE.readystate <> 4
DoEvents
Loop
Set Translation = IE.document.getElementById("Translation")
Translation.innertext = cell.Offset(1, 0).Value
Next cell
End Sub
4) There are two methods to move from one page to another. You can use a
submit button on a webpage or simply go to a new URL address. The code
below
goes to a specific webpage by generating a URL. The code is perform a
google
search for specific words onfrom a spreadsheet.
Public Sub GoogleSearch1()
'Use and input box for typing in the search words
Dim szSearchWords As String
Dim szResults As String
With Sheets("Sheet1")
szSearchWords = .Range("B2").Value
End With
If Not Len(szSearchWords) > 0 Then Exit Sub
'Get keywords and validate by adding + for spaces between
szSearchWords = Replace$(szSearchWords, " ", "+")
Dim ie As Object 'InternetExplorer
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate "
http://www.google.com/search?hl=en&q=" & _
szSearchWords & "&meta="
'Loop until the page is fully loaded
Const READYSTATE_COMPLETE = 4
Do Until ie.ReadyState = READYSTATE_COMPLETE
With ie
.Visible = True
End With
Loop
Set Results = ie.document.getelementsbytagname("P")
For Each itm In Results
If InStr(UCase(itm.innertext), "RESULTS") Then
MsgBox (itm.innertext)
Exit For
End If
Next itm
With Sheets("Sheet2")
RowCount = 1
For Each itm In ie.document.all
.Range("A" & RowCount) = itm.tagname
.Range("B" & RowCount) = itm.classname
.Range("C" & RowCount) = Left(itm.innertext, 1024)
RowCount = RowCount + 1
Next itm
.Cells.VerticalAlignment = xlTop
End With
Set Results = ie.document.getelementsbytagname("LI")
With Sheets("Sheet3")
RowCount = 1
For Each itm In Results
.Range("A" & RowCount) = itm.innertext
RowCount = RowCount + 1
Next itm
.Cells.VerticalAlignment = xlTop
End With
'Explicitly clear memory
Set ie = Nothing
End Sub
