How to bypass login screen when downloading file via vba.

Posted on 2010-08-26
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
  • 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

I originally created this report in Crystal Reports 2008 where there is an option to underlay sections. I initially came across the problem in Access Reports where I was unable to run my border lines down through the entire page as I was using the P…
In a multiple monitor setup, if you don't want to use AutoCenter to position your popup forms, you have a problem: where will they appear?  Sometimes you may have an additional problem: where the devil did they go?  If you last had a popup form open…
Familiarize people with the process of retrieving data from SQL Server using an Access pass-thru query. Microsoft Access is a very powerful client/server development tool. One of the ways that you can retrieve data from a SQL Server is by using a pa…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

929 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

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now