# Solved: excel web query



## cpossamai (Dec 23, 2008)

I am trying to do a web query on http://www.tntexpress.com.au/interaction/asps/transitTimes_tntau.asp with information entered into the text boxes and the result into excel.

I have tried using a macro but it failed and I'm not sure if I am supposed to use post or some other way for text boxes:

Sub Login_WebQuery()
Dim MyPost As String
Const MyUrl As String = "http://www.tntexpress.com.au/interaction/asps/transittimesX_tntau.asp?" 'DONT FORGET TO COPY LINK LOCATION BECAUSE TECH SUPPORT GUY SHORTENS THE ADDRESS

Const PostOSuburb As String = "txtOSuburb=CRANBOURNE" 
Const PostOState As String = "&txtOState=VIC" 
Const PostOCode As String = "&txtOPcode=3977" 
Const PostDSuburb As String = "&txtDSuburb=ASPENDALE"
Const PostDState As String = "&txtDState=VIC" 
Const PostDCode As String = "&txtDPcode=3195" 
Const Postcolmonth As String = "&colmonth=December" 
Const Postcolyear As String = "&colyear=2008"
Const Postcolhour As String = "&colhour=15" 
Const Postcolmin As String = "&colmin=00"

MyPost = PostOSuburb & PostOState & PostOPcode & PostDSuburb & PostDState & PostDPcode & Postcolmonth & Postcolyear & Postcolhour & Postcolmin

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & MyUrl, Destination:=Cells(1, 1))
.PostText = MyPost
.BackgroundQuery = True
.TablesOnlyFromHTML = True
.Refresh BackgroundQuery:=False
.SaveData = True
End With

End Sub

hope someone can help!

Thanks


----------



## cpossamai (Dec 23, 2008)

Further to my post (and also to bump up) The error produced is 'run time error 1004'
Unable to open http://www.tntexpress.com.au/interaction/asps/transittimesX_tntau.asp? (click on the link to see what I am talking about, enter in the inormation manually and the next page is the information I want displayed in Excel.)

Cannot download the information you requested.

and stops at .Refresh BackgroundQuery:=False

If I take out .PostText = MyPost

it will work but it wont give me the required information I need, it will be as if I didn't fill in any of the text boxes.

Please clarify with me the details if you think you can help me, but you don't quite understand what I am trying to do.

click on this link http://www.tntexpress.com.au/interaction/asps/transittimesX_tntau.asp? to see what I am talking about, enter in the inormation manually and the next page is the information I want displayed in Excel.


----------



## Zack Barresse (Jul 25, 2004)

Hi there!

Quick question. Why are you trying to query the search page and not the results page? Maybe it would be better to pass the information to the website, process the information and then query the results. You're looking for the results, right? Will your search information always be the same I take it?


----------



## cpossamai (Dec 23, 2008)

I have passed the information to the website using:

Sub IE_login()

Dim IE
Dim objShell
Dim ULogin As Boolean, ieForm
Dim MyPass As String, MyLogin As String, MyPass2 As String, MyLogin2 As String
Dim i As Integer

MyLogin = Application.InputBox("outgoing suburb", "VBAX username", Default:="login", Type:=2)
MyLogin2 = Application.InputBox("Please enter your outgoing state", "VBAX username", Default:="login", Type:=2)
MyLogin3 = Application.InputBox("Please enter your outgoing postcode", "VBAX username", Default:="login", Type:=2)
MyPass = Application.InputBox("Please enter your Destination suburb", "VBAX Password", Default:="Password", Type:=2)
MyPass2 = Application.InputBox("Please enter your Destination State", "VBAX Password", Default:="Password", Type:=2)
MyPass3 = Application.InputBox("Please enter your Destination postcode", "VBAX Password", Default:="Password", Type:=2)


Set IE = CreateObject("InternetExplorer.Application")
Set objShell = CreateObject("WScript.Shell")
With IE
.Left = 20
.Top = 20
.Height = 540
.Width = 950
.MenuBar = 0
.Toolbar = 1
.StatusBar = 0
.navigate "http://www.tntexpress.com.au/interaction/asps/transittimesX_tntau.asp?"
.Visible = True
End With

'wait until IE has finished loading itself.
Do While IE.busy
DoEvents
Loop
i = 0

For Each ieForm In IE.Document.forms


If i = 1 Then
ieForm(1).Value = MyLogin
ieForm(2).Value = MyLogin2
ieForm(3).Value = MyLogin3
ieForm(4).Value = MyPass
ieForm(5).Value = MyPass2
ieForm(6).Value = MyPass3
ieForm.submit
End If


i = i + 1

Next


End Sub



but I don't know now how to get it to excel.

What do I need to do? I'm using office 97


Thank you


----------



## cpossamai (Dec 23, 2008)

I have found the solution.

This is the entire macro:

Sub GetTransitTimes()
Dim MyPass As String, MyLogin As String, MyPass2 As String, MyLogin2 As String
Dim i As Integer
Dim m As Integer
Dim info As String
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True

Const URL1 = "http://www.tntexpress.com.au/interaction/asps/transittimesX_tntau.asp?"
MyLogin = Range("sheet2!A1:A1")
MyLogin2 = Range("sheet2!B1:B1")
MyLogin3 = Range("sheet2!C1:C1")
MyPass = Range("sheet2!A2:A2")
MyPass2 = Range("sheet2!B2:B2")
MyPass3 = Range("sheet2!C2:C2")
'get web page
IE.Navigate2 URL1
Do While IE.readystate <> 4
DoEvents
Loop

i = 0

For Each ieForm In IE.document.forms

If i = 1 Then
m = 0
For m = 1 To 1000
Next
ieForm(1).Value = MyLogin
ieForm(2).Value = MyLogin2
ieForm(3).Value = MyLogin3
ieForm(4).Value = MyPass
ieForm(5).Value = MyPass2
ieForm(6).Value = MyPass3
ieForm.submit
End If
i = i + 1
Next

Do While IE.readystate <> 4
DoEvents
Loop

m = 0
For m = 1 To 30000
i = 0
For i = 1 To 2500
Next
Next

Set SeniorManagement = IE.document.getelementsbytagname("A")

With Sheets("Sheet1")
RowCount = 1
For Each itm In SeniorManagement
.Range("A" & RowCount) = itm.Name
.Range("B" & RowCount) = itm.classname
.Range("C" & RowCount) = Left(itm.innertext, 1024)
RowCount = RowCount + 1
Next itm

End With
With Sheets("Sheet2")
RowCount = 1
For Each itm In SeniorManagement
If itm.classname = "a11purplemedium" Then
.Range("A" & RowCount) = itm.Name
.Range("B" & RowCount) = itm.classname
.Range("C" & RowCount) = Left(itm.innertext, 1024)
RowCount = RowCount + 1
End If
Next itm

End With
With Sheets("Sheet3")
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

End With
With Sheets("Sheet4")
RowCount = 0
State = GetManagement
For Each itm In IE.document.all
If itm.tagname = "SPAN" Then
RowCount = RowCount + 1
.Range("A" & RowCount) = itm.innertext
First = True
End If
If itm.tagname = "I" Then
.Range("B" & RowCount) = itm.innertext
End If
If itm.tagname = "P" And _
itm.tagname <> "" Then

If First = True Then
First = False
Else
RowCount = RowCount + 1
End If
.Range("C" & RowCount) = itm.innertext
End If
Next itm
End With

'filter information I need

info = Range("Sheet3!c151:c151")
Range("Sheet2!a4:a4").Value = Mid(info, 291, 100) & Mid(info, 858, 150)
Sheets("Sheet1").Select
Cells.Select
Selection.ClearContents
Sheets("Sheet3").Select
Cells.Select
Range("A150").Activate
Selection.ClearContents
Sheets("Sheet4").Select
Cells.Select
Selection.ClearContents
Sheets("Sheet1").Select
Range("A30").Select
End Sub

Thank you for your help.


----------



## Zack Barresse (Jul 25, 2004)

Does this do what you want? I was working on something different, but if it does what you want, I'll stop working on it.


----------



## cpossamai (Dec 23, 2008)

It does do what I want, but it is sections of code I found here and there, and I dont really understand it, and although I can adapt it to what I am doing, and it works, it seems like a waste of resources / like spagetti if you know what I mean. I'm sure I should be able to do it without all that code. 

Thank you
colin


----------

