Private Declare Function InternetGetConnectedState _
Lib "wininet.dll" (ByRef dwflags As Long, _
ByVal dwReserved As Long) As Long
Private Const INTERNET_CONNECTION_MODEM As Long = &H1
Private Const INTERNET_CONNECTION_LAN As Long = &H2
Private Const INTERNET_CONNECTION_PROXY As Long = &H4
Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20
Dim mySht As Worksheet
Function IsInternetConnected() As Boolean
Dim L As Long
Dim R As Long
R = InternetGetConnectedState(L, 0&)
If R = 0 Then
IsInternetConnected = False
Else
If R ＜= 4 Then
IsInternetConnected = True
Else
IsInternetConnected = False
End If
End If
End Function
Sub doviz_kurlari_anlik()
On Error Resume Next
On Error GoTo hata
Dim gun
Dim ay
Dim yil
Dim yeni_ac As Boolean
Dim sorgu
yeni_ac = True
sorgu = Date
baslangic1:
yil = Year(sorgu)
ay = Month(sorgu)
gun = Day(sorgu)
If Len(ay) ＜ 2 Then ay = "0" & ay
If Len(gun) ＜ 2 Then gun = "0" & gun
'If IsInternetConnected = False Then
' MsgBox "İnternet bağlantısı olmadığı için döviz kurlarını veremiyoruz."
' Exit Sub
'End If
If yeni_ac Then
Workbooks.Add
End If
ActiveWorkbook.XmlImport URL:= _
"http://www.tcmb.gov.tr/kurlar/" & yil & ay & "/" & gun & ay & yil & ".xml", ImportMap:=Nothing, _
Overwrite:=True, Destination:=Range("$A$1")
ActiveWindow.DisplayGridlines = False
If Range("A1").Value = "" Then
sorgu = DateValue(sorgu) - 1
yeni_ac = False
GoTo baslangic1
End If
hata:
If Err Then
MsgBox "İnternet bağlantısı var."
Exit Sub
End If
End Sub
'doviz_kurlari_anlik_tarih
Sub doviz_kurlari_anlik_tarih()
On Error Resume Next
Dim gun
Dim ay
Dim yil
Dim sorgu
Dim yeni_ac As Boolean
yeni_ac = True
sorgu = InputBox("Lütfen döviz kurlarını istediğiniz tarihi giriniz." & vbCrLf & "Veriyi GÜN.AY.YIL şeklinde giriniz.", _
"Tarih Girişi", Date)
baslangic:
yil = Year(sorgu)
ay = Month(sorgu)
gun = Day(sorgu)
If Len(ay) ＜ 2 Then ay = "0" & ay
If Len(gun) ＜ 2 Then gun = "0" & gun
If IsInternetConnected = False Then
MsgBox "İnternet bağlantısı olmadığı için döviz kurlarını veremiyoruz."
Exit Sub
End If
If yeni_ac Then
Workbooks.Add
End If
ActiveWorkbook.XmlImport URL:= _
"http://www.tcmb.gov.tr/kurlar/today.xml" & yil & ay & "/" & gun & ay & yil & ".xml", ImportMap:=Nothing, _
Overwrite:=True, Destination:=Range("$A$1")
ActiveWindow.DisplayGridlines = False
If Range("A1").Value = "" Then
sorgu = DateValue(sorgu) - 1
yeni_ac = False
GoTo baslangic
End If
End Sub
