Solved

How to bypass login screen when downloading file via vba.

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

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