Tosborn
New Member
- Joined
- May 24, 2016
- Messages
- 44
Logon to website using VBA
Hey all,
Trying to log in to a website with VBA & download a file.
Having troubles getting the code to login.
I’ve pulled up what the element is in IE but the code doesn’t seem to recognise it and no username or password gets put in at all.
Code is below, in particular the .elements part is not functioning
Any ideas on how I can fix?
Thanks so much.
Tim
Hey all,
Trying to log in to a website with VBA & download a file.
Having troubles getting the code to login.
I’ve pulled up what the element is in IE but the code doesn’t seem to recognise it and no username or password gets put in at all.
Code is below, in particular the .elements part is not functioning
Code:
Option Explicit
Private oBrowser As InternetExplorer
Private Sub openBrowserAndLogin()
Set oBrowser = New InternetExplorer
With oBrowser
.Visible = True
.navigate "https://www.cuscal.com.au/opensso/UI/Login"
Do While .Busy Or .readyState <> READYSTATE_COMPLETE
DoEvents
Loop
On Error Resume Next
With .document.forms("LoginForm")
.elements("IDToken1").Value = "username"
.elements("password").Value = "Password"
.submit
End With
On Error GoTo 0
Do While .Busy Or .readyState <> READYSTATE_COMPLETE
DoEvents
Loop
End With
End Sub
Private Function takeSnapshot() As String
Dim oTables As IHTMLElementCollection
Dim oTable As IHTMLElement
Dim sTableHTML As String
With oBrowser
Set oTables = .document.getElementById("fleetGrid").getElementsByTagName("table")
Set oTable = oTables(1)
sTableHTML = oTable.innerHTML
End With
takeSnapshot = sTableHTML
End Function
Private Sub getWebContentOnTime()
Dim oHTMLDoc As IHTMLDocument
Dim oTable As IHTMLElement
Dim oTR As IHTMLTableRow
Dim oCell As IHTMLTableCell
Dim oWS As Worksheet
Dim oClip As DataObject
Dim sTableHTML As String
Dim sDivClassName As String
Dim aClassProps As Variant
Dim dTime As Double
Dim lRows As Long
Dim lCols As Long
Dim lColsRow As Long
sTableHTML = takeSnapshot()
Set oHTMLDoc = New HTMLDocument
oHTMLDoc.body.innerHTML = "<html><table id=""t1"">" & sTableHTML & "</table></html>"
Set oTable = oHTMLDoc.getElementById("t1")
lRows = 0
lCols = 0
For Each oTR In oTable.Rows
lColsRow = 0
For Each oCell In oTR.Cells
sDivClassName = oCell.FirstChild.className
aClassProps = Split(sDivClassName, "_")
If aClassProps(0) = "fleet" Then
On Error Resume Next
oCell.Style.backgroundColor = aClassProps(1)
oCell.Style.Color = aClassProps(2)
On Error GoTo 0
End If
lColsRow = lColsRow + 1
Next
If lColsRow > lCols Then lCols = lColsRow
lRows = lRows + 1
Next
Set oClip = New DataObject
oClip.SetText "<html><table>" & oTable.innerHTML & "</table></html>"
oClip.PutInClipboard
Set oWS = ThisWorkbook.Worksheets(1)
oWS.Paste Destination:=oWS.Range(oWS.Cells(1, 1), oWS.Cells(lRows, lCols))
dTime = Now + TimeSerial(0, 0, 5)
Application.OnTime EarliestTime:=dTime, _
Procedure:="getWebContentOnTime", _
Schedule:=True
End Sub
Public Sub getWebContentMain()
Dim dTime As Double
Call openBrowserAndLogin
dTime = Now + TimeSerial(0, 0, 10)
Application.OnTime EarliestTime:=dTime, _
Procedure:="getWebContentOnTime", _
Schedule:=True
End SubAny ideas on how I can fix?
Thanks so much.
Tim
I have below sorce. I want to click on Send SMS Button (way2sms.com)
