Excle检测百度网盘是否失效
打开开发者工具 - 点击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`
```vbscript
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
``` 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
aichiyu 发表于 2024-5-2 15:29
你这判单是有问题的。。。
肯定不是最终的结果表格数据清洗 ，为了得到我最终的需求调试了差不多两个钟不过ai真的方便我们这些门外汉只需要知道原理即可不用深入学习 第一次知道Excel还能这么用 学习学习，曾经看了一段时间的VBA教程。 学习学习 学习一点VBA，简单用用不错 感谢大佬分享，学习了 学习了，正在研究VBA 越来越简单了。。。 批量检测，不错，可以研究学习下 太牛了吧