PDA

View Full Version : VBA to download data from website


vabatox
08-24-2009, 08:10 AM
Hi,

I've been trying to automate a VBA download from a website. I need the VBA to

1) Goto the website
2) tab to the username / password fields
3) enter username / password and 'ENTER'
4) Tab to relevant download button
5) enter 2 date parameters (start and end date)
6) specify wher to download too. C:\temp


here's my code. It links to some parameters in the spreadsheet. But i cant get it to work. any ideas?


Sub getdata()
'open ie
mybrowser = "C:\Program Files\Internet Explorer\IEXPLORE.EXE"
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 2
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
myurl = The website
timesheetlogin = Shell(mybrowser & " " & myurl, vbMaximizedFocus)
'wait
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 2
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
AppActivate timesheetlogin
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 3
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
'login
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 2
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
myuser = Cells(3, 3).Value
numletters = Len(myuser)
'get user
For i = 1 To numletters
myletter = Mid$(myuser, i, 1)
Select Case myletter
Case "a"
SendKeys "{a}", True
Case "b"
SendKeys "{b}", True
Case "c"
SendKeys "{c}", True
Case "d"
SendKeys "{d}", True
Case "e"
SendKeys "{e}", True
Case "f"
SendKeys "{f}", True
Case "g"
SendKeys "{g}", True
Case "h"
SendKeys "{h}", True
Case "i"
SendKeys "{i}", True
Case "j"
SendKeys "{j}", True
Case "k"
SendKeys "{k}", True
Case "l"
SendKeys "{l}", True
Case "m"
SendKeys "{m}", True
Case "n"
SendKeys "{n}", True
Case "o"
SendKeys "{o}", True
Case "p"
SendKeys "{p}", True
Case "q"
SendKeys "{q}", True
Case "r"
SendKeys "{r}", True
Case "s"
SendKeys "{s}", True
Case "t"
SendKeys "{t}", True
Case "u"
SendKeys "{u}", True
Case "v"
SendKeys "{v}", True
Case "w"
SendKeys "{w}", True
Case "x"
SendKeys "{x}", True
Case "y"
SendKeys "{y}", True
Case "z"
SendKeys "{z}", True
Case "@"
SendKeys "{@}", True
Case "/"
SendKeys "{/}", True
Case "."
SendKeys "{.}", True
End Select
Next i
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 2
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
SendKeys "{TAB}", True
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 2
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
'get password
mypswd = Cells(4, 3).Value
numletters = Len(mypswd)
For i = 1 To numletters
myletter = Mid$(mypswd, i, 1)
Select Case myletter
Case "a"
SendKeys "{a}", True
Case "b"
SendKeys "{b}", True
Case "c"
SendKeys "{c}", True
Case "d"
SendKeys "{d}", True
Case "e"
SendKeys "{e}", True
Case "f"
SendKeys "{f}", True
Case "g"
SendKeys "{g}", True
Case "h"
SendKeys "{h}", True
Case "i"
SendKeys "{i}", True
Case "j"
SendKeys "{j}", True
Case "k"
SendKeys "{k}", True
Case "l"
SendKeys "{l}", True
Case "m"
SendKeys "{m}", True
Case "n"
SendKeys "{n}", True
Case "o"
SendKeys "{o}", True
Case "p"
SendKeys "{p}", True
Case "q"
SendKeys "{q}", True
Case "r"
SendKeys "{r}", True
Case "s"
SendKeys "{s}", True
Case "t"
SendKeys "{t}", True
Case "u"
SendKeys "{u}", True
Case "v"
SendKeys "{v}", True
Case "w"
SendKeys "{w}", True
Case "x"
SendKeys "{x}", True
Case "y"
SendKeys "{y}", True
Case "z"
SendKeys "{z}", True
Case "@"
SendKeys "{@}", True
Case "/"
SendKeys "{/}", True
Case "."
SendKeys "{.}", True
End Select
Next i
'run login
AppActivate timesheetlogin
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{ENTER}", True
'get report URL
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 5
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
SendKeys "{F4}", True
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 2
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
myrepurl = Cells(6, 3).Value
numletters = Len(myrepurl)
For i = 1 To numletters
myletter = Mid$(myrepurl, i, 1)
Select Case myletter
Case 2
SendKeys "{2}", True
Case 4
SendKeys "{4}", True
Case 7
SendKeys "{7}", True
Case "a"
SendKeys "{a}", True
Case "b"
SendKeys "{b}", True
Case "c"
SendKeys "{c}", True
Case "d"
SendKeys "{d}", True
Case "e"
SendKeys "{e}", True
Case "E"
SendKeys "{E}", True
Case "f"
SendKeys "{f}", True
Case "g"
SendKeys "{g}", True
Case "h"
SendKeys "{h}", True
Case "i"
SendKeys "{i}", True
Case "j"
SendKeys "{j}", True
Case "k"
SendKeys "{k}", True
Case "l"
SendKeys "{l}", True
Case "m"
SendKeys "{m}", True
Case "M"
SendKeys "{M}", True
Case "n"
SendKeys "{n}", True
Case "o"
SendKeys "{o}", True
Case "p"
SendKeys "{p}", True
Case "q"
SendKeys "{q}", True
Case "r"
SendKeys "{r}", True
Case "s"
SendKeys "{s}", True
Case "t"
SendKeys "{t}", True
Case "T"
SendKeys "{T}", True
Case "u"
SendKeys "{u}", True
Case "v"
SendKeys "{v}", True
Case "w"
SendKeys "{w}", True
Case "x"
SendKeys "{x}", True
Case "y"
SendKeys "{y}", True
Case "z"
SendKeys "{z}", True
Case "@"
SendKeys "{@}", True
Case "/"
SendKeys "{/}", True
Case "."
SendKeys "{.}", True
Case ":"
SendKeys "{:}", True
End Select
Next i
AppActivate timesheetlogin
SendKeys "{ENTER}", True
SendKeys "{ENTER}", True
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 4
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
AppActivate timesheetlogin
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 2
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
'run dates
'start date
x = 13
y = 3
Do While x < 15
Do While y < 11
AppActivate timesheetlogin
mynumber = Cells(x, y).Value
Select Case mynumber
Case 1
SendKeys "{1}", True
Case 2
SendKeys "{2}", True
Case 3
SendKeys "{3}", True
Case 4
SendKeys "{4}", True
Case 5
SendKeys "{5}", True
Case 6
SendKeys "{6}", True
Case 7
SendKeys "{7}", True
Case 8
SendKeys "{8}", True
Case 9
SendKeys "{9}", True
Case 0
SendKeys "{0}", True
End Select
y = y + 1
Loop
y = 3
SendKeys "{TAB}", True
x = x + 1
Loop
'get extract
AppActivate timesheetlogin
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 2
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
SendKeys "{ENTER}", True
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 5
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
'enter destination path
AppActivate timesheetlogin
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{ENTER}", True
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 4
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
Filedt = "TSextract" & Day(Now()) & "-" & Month(Now()) & "-" & Year(Now()) & "_" & Hour(Now()) & "_" & Minute(Now())
pathfile = Cells(8, 3).Value & Filedt
'type path
numletters = Len(pathfile)
For i = 1 To numletters
myletter = Mid$(pathfile, i, 1)
Select Case myletter
Case 1
SendKeys "{1}", True
Case 2
SendKeys "{2}", True
Case 3
SendKeys "{3}", True
Case 4
SendKeys "{4}", True
Case 5
SendKeys "{5}", True
Case 6
SendKeys "{6}", True
Case 7
SendKeys "{7}", True
Case 8
SendKeys "{8}", True
Case 9
SendKeys "{9}", True
Case 0
SendKeys "{0}", True
Case "a"
SendKeys "{a}", True
Case "b"
SendKeys "{b}", True
Case "c"
SendKeys "{c}", True
Case "C"
SendKeys "{C}", True
Case "d"
SendKeys "{d}", True
Case "e"
SendKeys "{e}", True
Case "E"
SendKeys "{E}", True
Case "f"
SendKeys "{f}", True
Case "g"
SendKeys "{g}", True
Case "h"
SendKeys "{h}", True
Case "i"
SendKeys "{i}", True
Case "j"
SendKeys "{j}", True
Case "k"
SendKeys "{k}", True
Case "l"
SendKeys "{l}", True
Case "m"
SendKeys "{m}", True
Case "M"
SendKeys "{M}", True
Case "n"
SendKeys "{n}", True
Case "o"
SendKeys "{o}", True
Case "p"
SendKeys "{p}", True
Case "q"
SendKeys "{q}", True
Case "r"
SendKeys "{r}", True
Case "s"
SendKeys "{s}", True
Case "S"
SendKeys "{S}", True
Case "t"
SendKeys "{t}", True
Case "T"
SendKeys "{T}", True
Case "u"
SendKeys "{u}", True
Case "v"
SendKeys "{v}", True
Case "w"
SendKeys "{w}", True
Case "x"
SendKeys "{x}", True
Case "y"
SendKeys "{y}", True
Case "z"
SendKeys "{z}", True
Case "@"
SendKeys "{@}", True
Case "/"
SendKeys "{/}", True
Case "\"
SendKeys "{\}", True
Case "."
SendKeys "{.}", True
Case ":"
SendKeys "{:}", True
Case "-"
SendKeys "{-}", True
Case "_"
SendKeys "{_}", True
End Select
Next i
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 2
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
AppActivate timesheetlogin
'
SendKeys "{ENTER}", True
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 3
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
AppActivate timesheetlogin
SendKeys "{ENTER}", True
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 2
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
AppActivate timesheetlogin


SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{ENTER}", True
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 2
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime

SendKeys "{F10}", True
SendKeys "{UP}", True
SendKeys "{UP}", True
SendKeys "{ENTER}", True
End Sub