Access VBA test URL before proceed.

[gg]

I have this below code that logs into a website and to download data.

However, one problem that I am having is that in some cases when the website is already open I get an error. Obviously because the login screan in not there.

I am getting
Run-Time Error 91
Object Variable or With variable not set.

I expect this will occur alot in production of this program.

So, I can I test to see if the user is already logged into the site prior to sending the VBA request to login? If I am not logged in the it needs to do so, if not? then I just need to proceed on.

If logged in proceeed to here QPR.navigate ("https://www.portal.toyotasupplier.com/skpi/")

If not logged in then it can just follow the path as it is.

Option Compare Database

Option Explicit

Private Declare Function URLDownloadToFile Lib "urlmon" Alias _

"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _

ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Public Function SkpiUpdate()

Dim QPR As Object

Dim lnk As Object

Dim TimeOut As String

Dim frm As Object

Dim Start As Object

Dim Finish As Object

'Dim drp2 As Object

Dim drp1 As Object

Dim src1 As Object

Dim p1 As Variant

Dim objWB As Object

Dim objExc As Object

 

Set QPR = CreateObject("InternetExplorer.application")

 

    QPR.Visible = True

 

    QPR.navigate "https://www.portal.toyotasupplier.com/wps/myportal/"

 

  TimeOut = Now + TimeValue("00:00:20")  '-- wait maximum of 20 seconds

   Do While QPR.Busy Or QPR.readyState <> 4

      DoEvents

      If Now > TimeOut Then

        MsgBox "Time Out before Login"

        Exit Function

      End If

   Loop

 

   With QPR.Document.Forms("Login")

      .User.Value = "xxxxxxx"

      .Password.Value = "xxxxxxx"

      .submit

   End With

 

   TimeOut = Now + TimeValue("00:00:40")  '-- wait maximum of 10 seconds

   Do While QPR.Busy Or QPR.readyState <> 4

      DoEvents

      If Now > TimeOut Then

         MsgBox "Time Out after Login"

         Exit Function

      End If

   Loop

    QPR.navigate ("https://www.portal.toyotasupplier.com/skpi/")

 

      TimeOut = Now + TimeValue("00:00:05")  '-- wait 1 second for above navigation to take effect

      Do While Now < TimeOut

         DoEvents

      Loop

 

    TimeOut = Now + TimeValue("00:00:50")  '-- wait maximum of 10 seconds

   Do While QPR.Busy Or QPR.readyState <> 4

      DoEvents

      If Now > TimeOut Then

         MsgBox "Did not navigate to SKPI application"

         Exit Function

      End If

   Loop

 

   Set lnk = QPR.Document.Links(3)   ' 3=TMMK-VEH,4=TMMK-PWT,5=TMMC,6=TMMTX,7=TABC,8=NUMMI,9=TMMI,10=TMMBC,11=TMMAL,12=TMMNK

   lnk.Click

 

   TimeOut = Now + TimeValue("00:00:20")  '-- wait 1 second for above navigation to take effect

      Do While Now < TimeOut

         DoEvents

   Loop

 

   QPR.navigate ("https://www.portal.toyotasupplier.com/skpi/SkpiGatewayServlet?jadeAction=NCPARTS_SEARCH")

 

         TimeOut = Now + TimeValue("00:00:05")  '-- wait 1 second for above navigation to take effect

      Do While Now < TimeOut

         DoEvents

      Loop

 

    Set frm = QPR.Document.Forms("searchForm") ' was form1 before the change in December 2008

 

    Set Start = frm.all("SKPI_SEARCH_START_DATE_KEY")

    Start.Value = "01/01/" & Year(Now)

 

    Set Finish = frm.all("SKPI_SEARCH_END_DATE_KEY")

    Finish.Value = Format(Now - 1, "mm/dd/yyyy")

 

    'Set drp2 = frm.all("SKPI_SEARCH_NC_TYPE_KEY")

    'drp2.Item(1).Selected = True

 

    Set drp1 = frm.all("SKPI_SEARCH_NAMC_KEY")

    drp1.Item(p1).Selected = True

 

    Set src1 = frm.all("Search") 'was submit before December 2008 update

 

    src1.Click

 

    TimeOut = Now + TimeValue("00:00:05")  '-- wait 1 second for above navigation to take effect

      Do While Now < TimeOut

         DoEvents

    Loop

 

    QPR.navigate ("https://www.portal.toyotasupplier.com/skpi/DownloadNCPartListServlet")

 

    TimeOut = Now + TimeValue("00:01:00")  '-- wait 1 minute for above navigation to take effect

    Do While Now < TimeOut

         DoEvents

    Loop

 

   'QPR.navigate ("https://www.portal.toyotasupplier.com/public/pr_logout.htm")

 

   Const strUrl As String = "https://www.portal.toyotasupplier.com/skpi/DownloadNCPartListServlet"

    Dim strSavePath As String

    strSavePath = "C:\Users\Owner\Documents\_DENSO QRE\SKPI PARTS RETURN\SKPI_UPDATE.xls"

    Dim returnValue As Long

    returnValue = URLDownloadToFile(0, strUrl, strSavePath, 0, 0)

End Function