１つのPCで同じマクロを複数動かす
下記のマクロは、
A列にあるURLがSSL化（https）されているかを調べるものです。
このマクロで、いろんなURLを調べる作業があります。
その作業を早く完了させるために、下記のマクロを同時に動かそうと思っています。
しかし、エクセルを使えるPCが１つしかありません。
エクセルを２つ起動して、調べるURLを分けて、
２つのエクセルでマクロを同時に動かす。
これをやろうと思いましたが、かなりPCが重くなるし、
エクセルが度々フリーズしたみたいになります。
どうにか、１つのPCで下記のマクロを複数動かして、
いろんなURLを調べる作業を、早くに完了する方法はありますでしょうか？
エクセル2016です。
よろしくお願いいたします。
Sub SSL()
Dim objHttp As Object
Dim nURL As String
Dim strURL As String
Dim i As Long, f As String, l As String
Dim Lastrow As Long, getLine As Long
Set objHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
On Error GoTo ErrHandler
'A1から
getLine = Cells(Rows.Count, 2).End(xlUp).Row
Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
If getLine = Lastrow Then MsgBox "既に終わっているか、データがないです。", vbExclamation: Exit Sub
If getLine < Lastrow And Cells(1, 2).Value <> "" Then
getLine = getLine + 1
Else
getLine = 1 '最初の行が1行目からの場合
End If
For i = getLine To Lastrow
strURL = LCase(Trim(Cells(i, 1).Value)) 'A列の登録URL
strURL = Replace(strURL, "https:", "http:")
If strURL Like "http*" Then
objHttp.Open "GET", strURL, False
objHttp.send
DoEvents 'ESC割り込み可能にする
With objHttp
If .Status = 200 Then
nURL = .Option(1) 'WinHttpRequestOption_URL
f = Mid(strURL, 1, InStr(strURL, "://"))
l = Mid(nURL, 1, InStr(nURL, "://"))
If nURL = "" Then
Cells(i, 2).Value = "no URL"
ElseIf nURL <> "" Then
If LCase(f) = LCase(l) Then
Cells(i, 2).Value = "non SSL"
Else
Cells(i, 2).Value = "https"
End If
End If
Else
Cells(i, 2).Value = "Err:" & .Status
End If
End With
End If
Endline:
nURL = ""
strURL = ""
Next i
MsgBox "Finished"
Exit Sub
ErrHandler:
If Err() <> 0 Then
Cells(i, 2).Value = Err.Number 'マイナスになるのは外部エラー
GoTo Endline
End If
End Sub
お礼
ありがとうございます。 動作できました。 orでしたか…