URLからIPを調べるマクロ

質問

指定したURLのIPを調べたいのですが、
数が多くて手動でやるのは難しいです。

A列に複数のURLの羅列があり、
その隣に、URLのIPを記入させたいです。

これは、マクロでできますでしょうか？
そのマクロは、どのような記述になりますでしょうか？

エクセル2016です。
よろしくお願いいたします。

回答No.2

HohoPapa · ベストアンサー

オモシロソウで興味を引かれたので作成してみました。
Ａ列にurlの羅列があり、
そのIPアドレスをB列に出力しています。
IPV4アドレスでいいですね?

ポストしたコードは
DNSサーバーの設置状況（特に台数）に依存します。
もし期待通り動作しない場合は
適当なホスト名でNSLookupを実行し
その戻り値全数をポストしてみてください。

Option Explicit

'IPアドレス取得メイン
Sub PutIP()
　Dim rowEnd As Long
　Dim buf As String
　Dim i As Long

　rowEnd = Cells(Rows.Count, 1).End(xlUp).Row
　For i = 1 To rowEnd
　　buf = UrlToHost(Cells(i, 1).Value)
　　If Not buf = "" Then
　　　Cells(i, 2).Value = GetNsLookUp(buf)
　　End If
　Next i
End Sub

'nslookupを発行して戻り値からIPアドレスを取得
Function GetNsLookUp(buf As String)
　Const ChkStrLine = 4　'チェック開始行番号
　Dim WSH, wExec, sCmd As String, Result As String, tmp
　Dim LineCnt As Long
　Dim wkIP As String

　Set WSH = CreateObject("WScript.Shell")

　sCmd = "nslookup " & buf
　Set wExec = WSH.Exec("%ComSpec% /c " & sCmd)

　Do While wExec.Status = 0
　　DoEvents
　Loop

　Result = wExec.StdOut.ReadAll
　tmp = Split(Result, vbCrLf)

　If UBound(tmp) < ChkStrLine Then
　　GetNsLookUp = ""
　　Exit Function
　End If

　For LineCnt = ChkStrLine To UBound(tmp)
　　wkIP = GetIPAdddrss(tmp(LineCnt))
　　If wkIP <> "" Then
　　　GetNsLookUp = wkIP
　　　Exit Function
　　End If
　Next LineCnt
　Set wExec = Nothing
　Set WSH = Nothing
End Function

'//nslookupの戻り値からIPAddrss(V4)を取得
Function GetIPAdddrss(strIP) As String
　Dim wkStr1 As String
　Dim wkStr2 As String
　GetIPAdddrss = ""
　wkStr1 = StrConv(strIP, vbUpperCase)
　wkStr1 = Replace(wkStr1, Chr(9), "")
　wkStr1 = Replace(wkStr1, "ADDRESS:", "")
　wkStr2 = Trim(wkStr1)
　wkStr1 = Replace(wkStr2, ".", "")
　If IsNumeric(wkStr1) = True Then
　　GetIPAdddrss = wkStr2
　End If
End Function

'//urlからホスト名を取得
Function UrlToHost(InUrl As String) As String
　Dim wkpos As Long
　Dim wkStr As String
　UrlToHost = ""
　wkpos = InStr(InUrl, "//")
　If wkpos = 0 Then Exit Function
　wkStr = Right(InUrl, Len(InUrl) - wkpos - 1)
　wkpos = InStr(wkStr, "/")
　If wkpos = 0 Then Exit Function
　UrlToHost = Left(wkStr, wkpos - 1)
End Function

お礼

次々とIPを取得することができました。
ありがとうございます！

回答No.1

masatsan

お困りのようですね。
しかし大変恐縮ですが、これでは丸投げでだれかやってという感じ。
この掲示板はボランティアが答えているわけですから、
本当にお困りなら業者に依頼するのが良いかと。

とはいえ。現在手動でやっているのをマクロの記録で記録して
その後はそのマクロをいじって使い方を変えればよいのではないでしょうか。