Question

怎么利用excel对url进行批量的访问，看出那个url可以访问，哪个不可以，应该怎么做？？

在网上找到这个代码，但是在“[d1].Resize(a, 2) = arr”报错，是什么原因，有没有更好的方法？？？

Private k$
Sub d()
Dim dosStr$, arr, txtTime%, Matches, Match, a%, xa%
k = "数据正在处理 "
arr = Range([b1], [a65536].End(3))
For xa = 1 To UBound(arr)
GetProcess xa, UBound(arr)
dosStr = dosStr & vbCrLf & sPing(arr(xa, 1))
Next
a = 0
Dim regEx As Object
Set regEx = CreateObject("VBScript.RegExp")
With regEx
.Global = True
.Pattern = "\(\d.*loss\)"
Set Matches = .Execute(dosStr)
End With
For Each Match In Matches
a = a + 1
arr(a, 2) = Match
Next
[d1].Resize(a, 2) = arr
End Sub

Function sPing(sHost) As String

Dim oFSO, oShell, oTempFile, sLine$, sFilename$

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("Wscript.Shell")

sFilename = oFSO.GetTempName
oShell.Run "cmd /c ping " & sHost & " >>" & sFilename, 0, True
Set oTempFile = oFSO.OpenTextFile(sFilename, 1)

Do While oTempFile.AtEndOfStream <> True
sLine = oTempFile.Readline
sPing = sPing & Trim(sLine)
Loop

oTempFile.Close
oFSO.DeleteFile sFilename

End Function

Sub GetProcess(i As Integer, Al As Integer)

UserForm1.Show 0
k = k & ">"
If Len(k) > 20 Then k = "数据正在处理 >"
UserForm1.Label4.Caption = k
UserForm1.Label2.Width = i / Al * 200
UserForm1.Label3.Caption = Format(i / Al, "0%")
DoEvents
If i = Al Then
Unload UserForm1
MsgBox "数据处理完毕！", 64, "系统提示"
End If
End Sub

Answer 1

老实说，您找的这代码我看着头疼。。

不必这么麻烦，插入模块复制粘贴下面的自定义函数，

通过CreateObject("MSXML2.ServerXMLHTTP")，检测网址是否有效。

工作表公式调用或VBA过程调用都可以。

Answer 2

代码在下面，你看看。

Function CheckURL(ByVal url As String) As String
On Error Resume Next
With CreateObject("Msxml2.XMLHTTP")
.Open "GET", url, False
.Send
CheckURL = Len(.responseText) > 0
End With
End Function

Sub check()
Dim url1 As String, chk As Boolean
For i = 1 To 126
url1 = "http://" & Cells(i, "b").Value
chk = CheckURL(url1)
Cells(i, "c").Value = IIf(chk, "有效", "无效")
Next
End Sub