• ベストアンサー
  • 困ってます

URLからIPを調べるマクロ

  • 質問No.9625899
  • 閲覧数144
  • ありがとう数2
  • 気になる数0
  • 回答数2
  • コメント数0

お礼率 4% (25/505)

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

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

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

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

質問者が選んだベストアンサー

  • 回答No.2
  • ベストアンサー

ベストアンサー率 61% (224/365)

Excel(エクセル) カテゴリマスター
オモシロソウで興味を引かれたので作成してみました。
A列に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
お礼コメント
mute_low

お礼率 4% (25/505)

次々とIPを取得することができました。
ありがとうございます!
投稿日時:2019/06/16 01:54

その他の回答 (全1件)

  • 回答No.1

ベストアンサー率 15% (177/1147)

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

とはいえ。現在手動でやっているのをマクロの記録で記録して
その後はそのマクロをいじって使い方を変えればよいのではないでしょうか。
結果を報告する
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。
AIエージェント「あい」

こんにちは。AIエージェントの「あい」です。
あなたの悩みに、OKWAVE 3,600万件のQ&Aを分析して最適な回答をご提案します。

関連するQ&A

その他の関連するQ&Aをキーワードで探す

ピックアップ

ページ先頭へ