אופיס 365 באקסס - גישה לשערים יציגים באתר בנק

[נדמ]

האם יש למישהו קוד מוכן שמאשפר גישה מתוך VBA באקסס לאתר בנק כלשהו ולקבל במט"ח שער יציג / שער המחאות מהאתר?

תודה.

 

[אריה123]

לבקשתך

 Option Compare Database
'קישור לאינטרנט
Option Explicit
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias _
"InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, _
ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, _
ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As _
Long, ByVal lpBuffer As String, ByVal dwNumberOfBytesToRead As Long, _
lNumberOfBytesRead As Long) As Integer
Const INTERNET_OPEN_TYPE_PRECONFIG = 0 ' use registry configuration
Const INTERNET_FLAG_EXISTING_CONNECT = &H20000000
 
Public Function MyGetDollar()
On Error GoTo ErrorHandler
'קישור לשער הדולר
Dim hInternetSession As Long
Dim hUrl As Long
Dim ok As Boolean
Dim NumberOfBytesRead As Long
Dim Buffer As String, Buffer2 As String
Dim vLine As Variant
Dim URL As String
URL = "http://www.bankisrael.gov.il/heb.shearim/currency.php?curr=01"
' open an Internet session, and retrieve its handle
hInternetSession = InternetOpen("", INTERNET_OPEN_TYPE_PRECONFIG, _
vbNullString, vbNullString, 0)
If hInternetSession = 0 Then err.Raise vbObjectError + 1000, , _
"An error occurred calling InternetOpen function"
' open the file and retrieve its handle
hUrl = InternetOpenUrl(hInternetSession, URL, vbNullString, 0, _
INTERNET_FLAG_EXISTING_CONNECT, 0)
If hUrl = 0 Then err.Raise vbObjectError + 1000, , _
"An error occurred calling InternetOpenUrl function"
' prepare the receiving buffer
Buffer = Space(4096)
 
Do
' read a chunk of the file - returns True if no error
ok = InternetReadFile(hUrl, Buffer, Len(Buffer), NumberOfBytesRead)
' exit if error or no more data
If NumberOfBytesRead = 0 Or Not ok Then Exit Do
 
' save the data to the local file
Buffer2 = Buffer2 & Left$(Buffer, NumberOfBytesRead)
Loop
 
 
' חלוקת הקובץ שהורד לשורות
vLine = Split(Buffer2, vbLf)
' חילוץ החלקים השונים מהקובץ: תאריך העדכון, השער והשינוי מהשער הקודם
MyGetDollar = CheckPart("RATE", vLine)
 
' Update = CheckPart("LAST_UPDATE", vLine)
' Change = CheckPart("CHANGE", vLine)
 
 
' flow into the error handler
ErrorHandler:
' close internet handles, if necessary
If hUrl Then InternetCloseHandle hUrl
If hInternetSession Then InternetCloseHandle hInternetSession
 
' report the error to the client, if there is one
'If err Then err.Raise err.Number, , err.Description
End Function

 

[אריה123]

אם תצטרך עזרה להפעלת הפונקציה אשמח לעזור