Solved

How to bypass login screen when downloading file via vba.

Posted on 2010-08-26
5
359 Views
Last Modified: 2013-11-27
Hi,

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

DoEvents

Loop



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%\tinyweb.zip %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 = "https://filedownloadlink.com/files/classification" & "/415?date=" & file_date & "&format=" & format_val



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





End Sub

Open in new window

0
Comment
Question by:iamnamja
  • 2
  • 2
5 Comments
 
LVL 13

Expert Comment

by:Surone1
ID: 33531453
0
 

Author Comment

by:iamnamja
ID: 33531678
Hi Surone1.

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

Expert Comment

by:jaybenne2001
ID: 33532566
0
 

Expert Comment

by:jaybenne2001
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 RFC 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

          

          XMLreq.Send



          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.AddNew

                    

                    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

                    

                    rs.Update

              

                      ' <Securitiy/>

            

                      For Each cld In RFC.selectNodes("security")

            

                        rs2.AddNew

                        

                        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"

                            

                          Else

                          

                            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

                        

                        rs2.Update

        

                      Next

                    

                    ' <Notice/>

                    

                    Set ntc = job.selectSingleNode("notice")

  

                    rs3.AddNew

                    

                    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

                        

                    Else

                    

                        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

                    

                    rs3.Update



              End If

              

            Next

            

            ' Confirm to server

          

            XMLreq.Open "GET", URL & "&confirmation=yes", False

          

            XMLreq.Send

          

            rs.Close

          

            rs2.Close

          

            rs3.Close

          

            Loop

            

            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

0
 

Accepted Solution

by:
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.
0

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