Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

How to bypass login screen when downloading file via vba.

Posted on 2010-08-26
5
Medium Priority
?
387 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

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Question has a verified solution.

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

Microsoft Access has a limit of 255 columns in a single table; SQL Server allows tables with over 255 columns, but reading that data is not necessarily simple.  The final solution for this task involved creating a custom text parser and then reading…
The Internet has made sending and receiving information online a breeze. But there is also the threat of unauthorized viewing, data tampering, and phoney messages. Surprisingly, a lot of business owners do not fully understand how to use security t…
In Microsoft Access, learn the trick to repeating sub-report headings at the top of each page. The problem with sub-reports and headings: Add a dummy group to the sub report using the expression =1: Set the “Repeat Section” property of the dummy…
Add bar graphs to Access queries using Unicode block characters. Graphs appear on every record in the color you want. Give life to numbers. Hopes this gives you ideas on visualizing your data in new ways ~ Create a calculated field in a query: …

916 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