Kết nối API từ VBA Access

Sub LayDuBaoThoiTiet()



    Dim strCityName As String

    Dim strAPIKey As String

    Dim strURL As String

    Dim objHTTP As Object

    Dim strResponse As String

    Dim json As Object ' Cần một thư viện JSON parser



    ' --- Cấu hình ---

    strCityName = InputBox("Nhập tên thành phố (ví dụ: Hanoi, London):", "Nhập Thành Phố")

    If strCityName = "" Then

        MsgBox "Bạn chưa nhập tên thành phố.", vbExclamation

        Exit Sub

    End If

    strAPIKey = "YOUR_API_KEY" ' **THAY THẾ BẰNG API KEY CỦA BẠN**

    strURL = "https://api.openweathermap.org/data/2.5/weather?q=" & Replace(strCityName, " ", "%20") & "&appid=" & strAPIKey & "&units=metric" ' Đơn vị: Celsius



    ' --- Tạo đối tượng HTTP ---

    Set objHTTP = CreateObject("MSXML2.XMLHTTP60") ' Hoặc sử dụng "MSXML2.XMLHTTP" nếu v6.0 không có



    ' --- Gửi yêu cầu GET ---

    objHTTP.Open "GET", strURL, False

    objHTTP.send



    ' --- Kiểm tra trạng thái phản hồi ---

    If objHTTP.Status = 200 Then

        strResponse = objHTTP.responseText

        Debug.Print "Dữ liệu JSON nhận được:"

        Debug.Print strResponse



        ' --- Phân tích cú pháp JSON (cần thư viện JSON) ---

        ' VBA không có thư viện JSON tích hợp sẵn. Bạn cần sử dụng một thư viện bên ngoài.

        ' Một thư viện phổ biến là VBA-JSON (bạn có thể tìm và import nó vào project VBA của mình).

        ' Giả sử bạn đã import và có hàm ParseJson:

        ' Set json = ParseJson(strResponse)



        ' --- Lấy thông tin thời tiết (ví dụ) ---

        ' If Not json Is Nothing Then

        '     Dim strDescription As String

        '     Dim dblTemperature As Double

        '     Dim dblHumidity As Double

        '

        '     On Error Resume Next ' Bỏ qua lỗi nếu thuộc tính không tồn tại

        '     strDescription = json("weather")(1)("description")

        '     dblTemperature = json("main")("temp")

        '     dblHumidity = json("main")("humidity")

        '     On Error GoTo 0 ' Bật lại xử lý lỗi

        '

        '     MsgBox "Thời tiết tại " & strCityName & ":" & vbCrLf & _

        '            "Mô tả: " & strDescription & vbCrLf & _

        '            "Nhiệt độ: " & dblTemperature & " °C" & vbCrLf & _

        '            "Độ ẩm: " & dblHumidity & "%", vbInformation

        ' Else

        '     MsgBox "Không thể phân tích dữ liệu thời tiết.", vbExclamation

        ' End If



    Else

        MsgBox "Lỗi khi gọi API. Mã trạng thái: " & objHTTP.Status & vbCrLf & objHTTP.responseText, vbCritical

    End If



    ' --- Giải phóng đối tượng ---

    Set objHTTP = Nothing

    ' Set json = Nothing ' Nếu bạn sử dụng thư viện JSON



End Sub