Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17


How to bypass login screen when downloading file via vba.

Posted on 2010-08-26
Medium Priority
Last Modified: 2013-11-27

I have an access database where I need to download a file daily from a website, and then use this file to do some calculations.

The issue that I'm running into is that the website requires a log-in.  If I manually click "ok" to the log-in screen that pops up when the macro tries to download the data, then the macro and database runs fine.  But what I'm ultimately planning on doing is to have this run on a schedule so I would need a way to "bypass" the log in screen.  any ideas on how to do this?

I have included my code below.
Option Compare Database

Function Download_File(ByVal vWebFile As String, ByVal vLocalFile As String) As Boolean
Dim oXMLHTTP As Object, i As Long, vFF As Long, oResp() As Byte

'You can also set a ref. to Microsoft XML, and Dim oXMLHTTP as MSXML2.XMLHTTP
Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
oXMLHTTP.Open "GET", vWebFile, False 'Open socket to get the website
oXMLHTTP.Send 'send request '****** This is where I get the log in;

'Wait for request to finish
Do While oXMLHTTP.readyState <> 4

oResp = oXMLHTTP.responseBody 'Returns the results as a byte array

'Create local file and save results to it
vFF = FreeFile
If Dir(vLocalFile) <> "" Then Kill vLocalFile
Open vLocalFile For Binary As #vFF
Put #vFF, , oResp
Close #vFF

'Clear memory
Set oXMLHTTP = Nothing
End Function

Sub downloadSetup(dl_link As String, savefile As String)
'Download tiny web server to the %TEMP% directory, use local copy of winzip to unzip
'Obviously in a real world application you'd want to bring your own unzipper
Download_File dl_link, savefile
'Run_Program "winzip", "-e -o %TEMP%\ %TEMP%", INVISIBLE, Wait
End Sub

Sub download_data(dl_folder As String, format_val As String, dl_date As Date)
Dim latest_date As Date
Dim file_date As String, link As String

latest_date = dl_date

If (Right(dl_folder, 1) <> "\") Then
    dl_folder = dl_folder & "\"
End If

    file_date = Format(Year(latest_date), "0000") & Format(Month(latest_date), "00") & Format(Day(latest_date), "00")
        link = "" & "/415?date=" & file_date & "&format=" & format_val

        Call downloadSetup(link, dl_folder & product_grp & file_date & ".txt")

End Sub

Open in new window

Question by:iamnamja
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
LVL 13

Expert Comment

ID: 33531453

Author Comment

ID: 33531678
Hi Surone1.

I tried this, but doesn't seem to work.  Any other ideas? Thanks.

Expert Comment

ID: 33532566

Expert Comment

ID: 33532584
Here is the code I use with that URL:
Public Function Sync()

      Dim doc As New MSXML2.DOMDocument
      Dim job As MSXML2.IXMLDOMNode
      Dim ntc As MSXML2.IXMLDOMNode
      Dim cld As MSXML2.IXMLDOMNode
      Dim rs As New ADODB.Recordset         ' RFC
      Dim rs2 As New ADODB.Recordset        ' SEC
      Dim rs3 As New ADODB.Recordset        ' NOT
      Dim i As Long
      Dim x As Long
      Dim XMLreq As MSXML2.XMLHTTP60
      Dim XMLdoc As MSXML2.DOMDocument
      Dim blnComplete As Boolean
        Do Until blnComplete = True
          i = i + 1
          Set XMLreq = New MSXML2.XMLHTTP60
          Set XMLdoc = New MSXML2.DOMDocument60

          XMLreq.Open "GET", URL, False

          Set XMLdoc = XMLreq.responseXML
          Set cld = doc.documentElement
          ' Check if load is complete:
            Select Case XMLdoc.documentElement.getAttribute("incomplete")
              Case Is = "true"
                blnComplete = False
              Case Is = "false"
                blnComplete = True
            End Select
          rs.Open "RFC", CurrentProject.Connection, adOpenKeyset, adLockOptimistic, adCmdTable
          rs2.Open "SEC", CurrentProject.Connection, adOpenKeyset, adLockOptimistic, adCmdTable
          rs3.Open "NTC", CurrentProject.Connection, adOpenKeyset, adLockOptimistic, adCmdTable
            For Each job In XMLdoc.documentElement.selectNodes("job")
              Set RFC = job.selectSingleNode("rfc")
                  ' RFC
                  DeleteRecord "RFC", "RFC_JobNumber", job.selectSingleNode("jobnumber").Text
                  DeleteRecord "SEC", "SEC_JobNumber", job.selectSingleNode("jobnumber").Text
                  DeleteRecord "NTC", "NTC_JobNumber", job.selectSingleNode("jobnumber").Text
                  If IsNumeric(RFC.selectSingleNode("redemptiondate").Text) Then
                    rs.Fields("RFC_Status") = job.selectSingleNode("status").Text
                    rs.Fields("RFC_LastUpdate") = (job.selectSingleNode("datelastupdate").Text)
                    rs.Fields("RFC_JobNumber") = job.selectSingleNode("jobnumber").Text
                    rs.Fields("RFC_RedemptionDate") = GetDate(RFC.selectSingleNode("redemptiondate").Text)
                    rs.Fields("RFC_CallType") = RFC.selectSingleNode("calltype").Text
                    rs.Fields("RFC_CallAmount") = RFC.selectSingleNode("callamount").Text
                    rs.Fields("RFC_TotalPayment") = RFC.selectSingleNode("totalpayment").Text
                    rs.Fields("RFC_TypeOfCallRequested") = RFC.selectSingleNode("typeofcallrequested").Text
                    rs.Fields("RFC_DocSectPageRedemption") = RFC.selectSingleNode("docsectpageredemption").Text
                    rs.Fields("RFC_Multiples") = RFC.selectSingleNode("multiples").Text
                    rs.Fields("RFC_Intraperiod") = UCase(RFC.selectSingleNode("isintraperiodcall").Text)
                    rs.Fields("RFC_Destroyable") = CBool(RFC.selectSingleNode("destroyable").Text = "Yes")
                    rs.Fields("RFC_Issuer") = UCase(RFC.selectSingleNode("issuer").Text)
                    rs.Fields("RFC_Issue") = UCase(RFC.selectSingleNode("issue").Text)
                    rs.Fields("RFC_AccountNumber") = RFC.selectSingleNode("accountnumber").Text
                    rs.Fields("RFC_AccountManager") = RFC.selectSingleNode("accountmanager").Text
                    rs.Fields("RFC_RequestApprover") = RFC.selectSingleNode("requestapprover").Text
                    Set cld = RFC.selectSingleNode("tfmanalyst")
                    rs.Fields("RFC_TFMAnalyst") = cld.selectSingleNode("firstname").Text & " " & cld.selectSingleNode("lastname").Text
                    rs.Fields("RFC_AnalystPhone") = FormatPhone(Trim(RFC.selectSingleNode("analystphone").Text))
                    rs.Fields("RFC_AnalystFax") = FormatPhone(Trim(RFC.selectSingleNode("analystfax").Text))
                    rs.Fields("RFC_TFMRegion") = RFC.selectSingleNode("tfmregion").Text
                    rs.Fields("RFC_MailStation") = RFC.selectSingleNode("mailstation").Text
                    rs.Fields("RFC_Database") = RFC.selectSingleNode("database").Text
                    rs.Fields("RFC_InternalNumber") = RFC.selectSingleNode("internalnumber").Text
                    rs.Fields("RFC_LoanType") = RFC.selectSingleNode("loantype").Text
                    rs.Fields("RFC_AccountingSystem") = RFC.selectSingleNode("accountingsystem").Text
                    rs.Fields("RFC_Entity") = RFC.selectSingleNode("entity").Text
                    rs.Fields("RFC_MailDate") = GetDate(RFC.selectSingleNode("maildate").Text)
                    rs.Fields("RFC_TypeOfMailClass") = RFC.selectSingleNode("typeofmailclass").Text
                    rs.Fields("RFC_IsSecondNoticeRequired") = CBool(RFC.selectSingleNode("issecondnoticerequired").xml = "Yes")
                    rs.Fields("RFC_MinimumDaysRequired") = RFC.selectSingleNode("minimumdaysrequired").Text
                    rs.Fields("RFC_MaximumDaysRequired") = RFC.selectSingleNode("maximumdaysrequired").Text
                    rs.Fields("RFC_MailDaysAfterCallDate") = RFC.selectSingleNode("maildaysaftercalldate").Text
                    rs.Fields("RFC_DocSectPageMailing") = RFC.selectSingleNode("docsectpagemailing").Text
                    rs.Fields("RFC_DisclosedToNRMSIRsSIDsDTC") = RFC.selectSingleNode("disclosedtonrmirssidsdtc").Text
                    rs.Fields("RFC_WillTheFeeBeRecovered") = CBool(RFC.selectSingleNode("willthefeeberecovered").Text = "Yes")
                    rs.Fields("RFC_FeeRecoveryAccount") = RFC.selectSingleNode("feerecoveryaccount").Text
                    rs.Fields("RFC_BillIssuerDirectly") = CBool(RFC.selectSingleNode("billissuerdirectly").Text = "Yes")
                    rs.Fields("RFC_MethodToSelectBonds") = RFC.selectSingleNode("methodtoselectbonds").Text
                    rs.Fields("RFC_DocSectPageBondSelection") = RFC.selectSingleNode("docsectpagebondselection").Text
                    'rs.Fields(38) = "" ' rfc.SelectSingleNode("#text").Text
                    'rs.Fields(39) = "" 'rfc.SelectSingleNode("security").Text
                    rs.Fields("RFC_BondsMustBeSubmittedForPayment") = CBool(RFC.selectSingleNode("bondsmustbesubmittedforpayment").Text = "Yes")
                    rs.Fields("RFC_WithholdIPI") = CBool(RFC.selectSingleNode("withholdipi").Text = "Yes")
                    rs.Fields("RFC_WithholdRSI") = CBool(RFC.selectSingleNode("withholdrsi").Text = "Yes")
                    rs.Fields("RFC_SpecialNotes") = RFC.selectSingleNode("specialnotes").Text
                    rs.Fields("RFC_AnalystSubmitted") = CBool(RFC.selectSingleNode("analystsubmitted").Text = "Yes")
                    rs.Fields("RFC_CusipCount") = RFC.selectNodes("security").length
                      ' <Securitiy/>
                      For Each cld In RFC.selectNodes("security")
                        rs2.Fields("SEC_JobNumber") = job.selectSingleNode("jobnumber").Text
                        rs2.Fields("SEC_database") = RFC.selectSingleNode("database").Text
                        rs2.Fields("SEC_Cab") = cld.selectSingleNode("cab").Text
                        rs2.Fields("SEC_Cusip") = cld.selectSingleNode("cusip").Text
                          ' Handle variable rates:
                          If cld.selectSingleNode("rate").Text = 0 Then
                            rs2.Fields("SEC_Rate") = "VARIABLE"
                            rs2.Fields("SEC_Rate") = cld.selectSingleNode("rate").Text & "%"
                          End If
                        rs2.Fields("SEC_Price") = Val(cld.selectSingleNode("price").Text)
                        rs2.Fields("SEC_Maturity") = GetDate(cld.selectSingleNode("maturity").Text)
                        rs2.Fields("SEC_CallType") = cld.selectSingleNode("calltype").Text
                        rs2.Fields("SEC_CalledAmount") = cld.selectSingleNode("calledamount").Text
                        rs2.Fields("SEC_CabsFundsAvailable") = cld.selectSingleNode("cabsfundsavailable").Text
                        rs2.Fields("SEC_CabsOutstanding") = cld.selectSingleNode("cabsoutstanding").Text
                        rs2.Fields("SEC_CabsParValue") = cld.selectSingleNode("cabsparvalue").Text
                        rs2.Fields("SEC_AccretedValue") = cld.selectSingleNode("accretedvalue").Text
                    ' <Notice/>
                    Set ntc = job.selectSingleNode("notice")
                    rs3.Fields("NTC_JobNumber") = job.selectSingleNode("jobnumber").Text
                    rs3.Fields("NTC_SubType") = ntc.selectSingleNode("subtype").Text
                    Set cld = ntc.selectSingleNode("operations")
                    If cld.hasChildNodes = True Then
                        rs3.Fields("NTC_Operations") = cld.selectSingleNode("firstname").Text & " " & cld.selectSingleNode("lastname").Text
                        rs3.Fields("NTC_Operations") = ntc.selectSingleNode("operations").Text
                    End If
                    'rs3.Fields("NTC_Operations") = ntc.selectSingleNode("operations").firstChild.Text & " " & ntc.selectSingleNode("operations").lastChild.Text
                    rs3.Fields("NTC_DTCNotice") = ntc.selectSingleNode("dtcnotice").Text
                    rs3.Fields("NTC_Depository") = ntc.selectSingleNode("depository").Text
                    rs3.Fields("NTC_FinancialStatements") = ntc.selectSingleNode("financialstatements").Text & ""
                    rs3.Fields("NTC_Memo") = ntc.selectSingleNode("memo").Text
                    rs3.Fields("NTC_Issuer") = ntc.selectSingleNode("issuer").Text
                    rs3.Fields("NTC_Issue") = ntc.selectSingleNode("issue").Text
                    rs3.Fields("NTC_CallDate") = GetDate(ntc.selectSingleNode("calldate").Text)
                    rs3.Fields("NTC_MailDate") = GetDate(ntc.selectSingleNode("maildate").Text)
                    rs3.Fields("NTC_JobType") = ntc.selectSingleNode("jobtype").Text
                    rs3.Fields("NTC_PublishNotice") = ntc.selectSingleNode("publishnotice").Text
                    rs3.Fields("NTC_CallAmount") = ntc.selectSingleNode("callamount").Text
                    rs3.Fields("NTC_AmountIssued") = ntc.selectSingleNode("amountissued").Text
                    rs3.Fields("NTC_TotalAmountRedeemed") = ntc.selectSingleNode("totalamountredeemed").Text
                    rs3.Fields("NTC_IssueDate") = GetDate(ntc.selectSingleNode("issuedate").Text)
                    rs3.Fields("NTC_LoanAccountNumber") = ntc.selectSingleNode("loanaccountnumber").Text
                    rs3.Fields("NTC_CostRecoveryCode") = ntc.selectSingleNode("costrecoverycode").Text
                    rs3.Fields("NTC_RegionCode") = ntc.selectSingleNode("regioncode").Text
                    rs3.Fields("NTC_LoanCode") = ntc.selectSingleNode("loancode").Text
                    rs3.Fields("NTC_Loan") = ntc.selectSingleNode("loan").Text

              End If
            ' Confirm to server
            XMLreq.Open "GET", URL & "&confirmation=yes", False
            Set rs = Nothing
            Set rs2 = Nothing
            Set rs3 = Nothing
            DoCmd.SetWarnings False
            'DoCmd.Close acForm, "frmJobStatus", acSaveYes
'            DoCmd.DeleteObject acTable, "tblMain"
            DoCmd.OpenForm "frmJobStatus", acNormal
            DoCmd.SetWarnings True

End Function

Open in new window


Accepted Solution

iamnamja earned 0 total points
ID: 33576979
I have used CURL to create a .bat file to connect to the secure website and download the file that I needed.

Featured Post

Are You Ready for GDPR?

With the GDPR deadline set for May 25, 2018, many organizations are ill-prepared due to uncertainty about the criteria for compliance. According to a recent WatchGuard survey, a staggering 37% of respondents don't even know if their organization needs to comply with GDPR. Do you?

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

It’s the first day of March, the weather is starting to warm up and the excitement of the upcoming St. Patrick’s Day holiday can be felt throughout the world.
We live in a world of interfaces like the one in the title picture. VBA also allows to use interfaces which offers a lot of possibilities. This article describes how to use interfaces in VBA and how to work around their bugs.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …

704 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question