Excle检测百度网盘是否失效

aichiyu

打开开发者工具 - 点击Visual Basic - 选择表右键点击插入选择模块 - 复制代码进去

vba不支持并发所以很慢，如果很多链接建议打开延迟。

最低延迟1秒 删除开头'

'Application.Wait (Now + TimeValue("0:00:01")) ' 时间单位是秒，所以这里是1秒，如果要500毫秒，可以设置为0.5秒

最后一行可以把 For i = 开始 To 结束 结束替换为 Cells(Rows.Count, linkColumn).End(xlUp).Row

Sub 访问链接并写入结果()
    Dim objHTTP As Object
    Dim strURL As String
    Dim strResult As String
    Dim i As Integer
    Dim linkColumn As Integer
    Dim 开始 As Integer
    Dim 结束 As Integer

    ' 提示用户输入链接所在的列
    linkColumn = InputBox("请输入链接所在的列（例如：B列输入2，结果显示2+1列 C列）", "链接在哪一列", 2)
    开始 = InputBox("请输入第几行开始", "行数", 1)
    结束 = InputBox("请输入第几行结束", "行数", 10)

    ' 从指定的列开始遍历链接，直到最后一行 Cells(Rows.Count, linkColumn).End(xlUp).Row
    For i = 开始 To 结束
        ' 获取当前行的链接地址
        strURL = Cells(i, linkColumn).Hyperlinks(1).Address

        ' 创建 HTTP 请求对象
        Set objHTTP = CreateObject("MSXML2.XMLHTTP")

        ' 发送 HTTP 请求
        objHTTP.Open "GET", strURL, False
        objHTTP.send

        ' 获取请求结果
        strResult = objHTTP.responseText

        ' 判断标题内容并写入相应的单元格
        If InStr(strResult, "<title>百度网盘-链接不存在</title>") > 0 Then
            Cells(i, linkColumn + 1).Value = "失效"
        ElseIf InStr(strResult, "<title>百度网盘 请输入提取码</title>") > 0 Then
            Cells(i, linkColumn + 1).Value = "链接没问题"
        Else
            Cells(i, linkColumn + 1).Value = "未知状态，可能不需要提取码"
        End If

        ' 将结果写入当前行的下一列单元格
        'Cells(i, linkColumn + 2).Value = strResult

        ' 添加延迟500毫秒
        'Application.Wait (Now + TimeValue("0:00:01")) ' 时间单位是秒，所以这里是1秒，如果要500毫秒，可以设置为0.5秒

    Next i
End Sub

deson37234

Option Explicit

Function CheckBaiduPanLink(ByVal url As String) As Boolean
    Dim http As Object
    Set http = CreateObject("MSXML2.ServerXMLHTTP")
    http.Open "HEAD", url, False
    http.Send
    CheckBaiduPanLink = (http.Status = 200)
End Function

Sub Test()
    Dim url As String
    url = "https://pan.baidu.com/s/1gfQ7YUW" '请替换为实际的百度网盘链接
    If CheckBaiduPanLink(url) Then
        MsgBox "链接有效"
    Else
        MsgBox "链接失效"
    End If
End Sub

deson37234

aichiyu 发表于 2024-5-2 15:29
你这判单是有问题的。。。

肯定不是最终的结果  表格数据清洗 ，为了得到我最终的需求  调试了差不多两个钟  不过ai真的方便我们这些门外汉  只需要知道原理即可  不用深入学习

士兵许三多

第一次知道Excel还能这么用

龍謹

学习学习，曾经看了一段时间的VBA教程。

deffedyy

学习学习

泡菜久坛

学习一点VBA，简单用用不错

Finssss

感谢大佬分享，学习了

bjxiaoyao

学习了，正在研究VBA

MQ19781011

越来越简单了。。。

jnath_126

批量检测，不错，可以研究学习下

dazuyishi1314

太牛了吧