当前位置:首页分享Excel vba 批量查询IP地址

Excel vba 批量查询IP地址

需要先导入JSON下载地址:https://github.com/VBA-tools/VBA-JSON

打开VBA编辑器,选择导入,选择下好的文件JsonConverter.bas导入

然后新建宏,把代码添加进去即可。

Sub GetIPAddressDetails()
    Dim rng As Range
    Dim cell As Range
    Dim xmlhttp As Object
    Dim json As Object
    Dim address As String
    Dim ip As String
    ' 设置要处理的IP地址列范围
    Set rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    ' 创建XMLHttpRequest对象
    Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
    ' 循环处理每个单元格
    For Each cell In rng
        ' 获取IP地址
        ip = cell.Value
        ' 发送GET请求获取JSON数据
        xmlhttp.Open "GET", "https://searchplugin.csdn.net/api/v1/ip/get?ip=" & ip, False
        xmlhttp.send
        ' 检查请求是否成功
        If xmlhttp.Status = 200 Then
            ' 解析JSON数据
            On Error Resume Next ' 避免在解析失败时抛出错误
            Set json = JsonConverter.ParseJson(xmlhttp.responseText)
            On Error GoTo 0 ' 恢复错误处理
            If Not json Is Nothing Then
                ' 检查是否包含数据节点
                If json("data") Is Nothing Then
                    MsgBox "JSON数据中缺少数据节点!", vbExclamation
                Else
                    ' 获取地址信息
                    address = json("data")("address")
                    ' 将地址信息写入B列
                    cell.Offset(0, 1).Value = address
                End If
            Else
                MsgBox "JSON数据解析失败!", vbExclamation
            End If
        Else
            MsgBox "请求失败:" & xmlhttp.Status & " - " & xmlhttp.statusText, vbExclamation
        End If
        ' 等待1秒
        Application.Wait (Now + TimeValue("0:00:01"))
    Next cell
    ' 释放对象
    Set xmlhttp = Nothing
    Set json = Nothing
End Sub

声明:本站所有文章,如无特殊说明或标注,均为本站原创发布。任何个人或组织,在未征得本站同意时,禁止复制、盗用、采集、发布本站内容到任何网站、书籍等各类媒体平台。如若本站内容侵犯了原著者的合法权益,可联系我们进行处理。
0 条回复 A文章作者 M管理员
    暂无讨论,说说你的看法吧