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

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

When you are entering numbers in a speadsheet, and don't remember what 6×7 is, you just type “=6*7" instead. It works in every cell! This is not so in Access. To enter the elusive 42 in a text box, you have to find a calculator, and then copy the re…
Experts-Exchange is a great place to come for help with solutions for your database issues, and many problems are resolved within minutes of being posted.  Others take a little more time and effort and often providing a sample database is very helpf…
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

747 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

13 Experts available now in Live!

Get 1:1 Help Now