iamnamja
asked on
How to bypass login screen when downloading file via vba.
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.
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
ASKER
Hi Surone1.
I tried this, but doesn't seem to work. Any other ideas? Thanks.
I tried this, but doesn't seem to work. Any other ideas? Thanks.
How about one like this?
Public Const URL As String = "https://www.ezdisclose.com//app.aspx?template=generate_job_xml.ascx&user_id=jpbenne&password=12345678"
Public Const URL As String = "https://www.ezdisclose.com//app.aspx?template=generate_job_xml.ascx&user_id=jpbenne&password=12345678"
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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
https://www.experts-exchange.comusername:password@/