Once again, trying to help out in a forum discussion in which the user was wanting to retrieve the IP Address of a host name.
The trick here is to know that there exists an ancient DOS (oh yes, that ancient beast) command that enables one to easily retrieve such information, the nslookup command.
So the question becomes
How can I run nslookup in VBA?
From there, it is just a question of building a wrapper to execute the command and parse the returned response. Another important element here is that some host can return multiple addresses, so you need to be able to loop through the returned information as it isn’t always the same.
That all being said, it didn’t take long to come up with the following little function:
'---------------------------------------------------------------------------------------
' Procedure : GetHostNameIP
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Retrieve the IP Address of a given host name
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Late Binding -> none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sHostName : Host name to lookup the IP address of
'
' Usage:
' ~~~~~~
' GetHostNameIP("utteraccess.com")
' Returns -> 52.40.49.196
' GetHostNameIP("google.com")
' Returns -> 2607:f8b0:4006:813::200e,172.217.10.238
'
' Revision History:
' Rev Date(yyyy-mm-dd) Description
' **************************************************************************************
' 1 2020-07-20 Initial Release, Forum Help
' 2 2020-07-20 Update to handle the case of multiple addresses
' 3 2020-07-21 Handle blank/empty sHostName calls
'---------------------------------------------------------------------------------------
Function GetHostNameIP(ByVal sHostName As String) As String
Dim sResult As String
Dim aResult As Variant
Dim i As Long
On Error GoTo Error_Handler
If Len(Trim(sHostName)) = 0 Then GoTo Error_Handler_Exit
sResult = CreateObject("Wscript.Shell").Exec("nslookup " & sHostName).StdOut.ReadAll
aResult = Split(sResult, vbCrLf)
If UBound(aResult) > 2 Then
For i = 4 To UBound(aResult)
If Len(Trim(aResult(i) & vbNullString)) > 0 Then
GetHostNameIP = GetHostNameIP & Trim(Replace(Replace(Replace(aResult(i), "Address:", ""), "Addresses:", ""), vbTab, "")) & ","
End If
Next i
If Right(GetHostNameIP, 1) = "," Then GetHostNameIP = Left(GetHostNameIP, Len(GetHostNameIP) - 1)
End If
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: GetHostNameIP" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
Now, the above worked absolutely fine, but it did cause a momentary screen flash, being the perfectionist that I am, this flickering annoyed me, so I continued to work on the problem. The issue is that .Exec always causes a flash, there is no way around it (someone please correct me if I am wrong and there is a simple solution that I am unaware of) and as such, the only way around the screen flash is to use .Run instead. However, .Run doesn’t return the value like .Exec does, so we have to first push the .Run command results to a text file and read the text file into memory to work with. Long story short, below is a version that does not cause the screen to flash/flicker.
'---------------------------------------------------------------------------------------
' Procedure : GetHostNameIP
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Retrieve the IP Address of a given host name
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Late Binding -> none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sHostName : Host name to lookup the IP address of
'
' Usage:
' ~~~~~~
' GetHostNameIP("utteraccess.com")
' Returns -> 52.40.49.196
' GetHostNameIP("google.com")
' Returns -> 2607:f8b0:4006:813::200e,172.217.10.238
'
' Revision History:
' Rev Date(yyyy-mm-dd) Description
' **************************************************************************************
' 1 2020-07-20 Initial Release
' Different approach to avoid screen flashing
' 2 2020-07-21 Handle blank/empty sHostName calls
'---------------------------------------------------------------------------------------
Function GetHostNameIP(ByVal sHostName As String) As String
Dim sFile As String
Dim sResult As String
Dim aResult As Variant
Dim i As Long
On Error GoTo Error_Handler
If Len(Trim(sHostName)) = 0 Then GoTo Error_Handler_Exit
sFile = Environ("temp") & "\GetHostNameIP.txt"
'Run the nslookup command and save its results to a text file
CreateObject("Wscript.Shell").Run "cmd /c nslookup " & sHostName & " > " & sFile, 0, True
With CreateObject("Scripting.FileSystemObject")
'Read the contents of the text file into memory
sResult = .OpenTextFile(sFile).ReadAll()
'Delete the text file
.DeleteFile sFile
End With
aResult = Split(sResult, vbCrLf)
If UBound(aResult) > 2 Then
For i = 4 To UBound(aResult)
If Len(Trim(aResult(i) & vbNullString)) > 0 Then
GetHostNameIP = GetHostNameIP & Trim(Replace(Replace(Replace(aResult(i), "Address:", ""), "Addresses:", ""), vbTab, "")) & ","
End If
Next i
If Right(GetHostNameIP, 1) = "," Then GetHostNameIP = Left(GetHostNameIP, Len(GetHostNameIP) - 1)
End If
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: GetHostNameIP" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
Both functions work equally well, the first one is slightly faster (based on very small test sample it ran about 1% faster, so very negligible), but flickers and the second one is slightly slower, but doesn’t flicker. You choose which one suits your needs best.
The Final Solution
Although pushing the results to a text file resolves one problem, the screen flicker, it is still not ideal as we are needlessly creating I/O operations and thus I kept working on perfecting the above.
Luckily, there is a very simple solution (well simple, once you are aware it exists!) to this issue, use the clipboard. So instead of pushing the results to a text file, we simply push them to the clipboard and then retrieve the clipboard content to extract what we are after. Thus, our final function becomes
'---------------------------------------------------------------------------------------
' Procedure : GetHostNameIP
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Retrieve the IP Address of a given host name
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Late Binding -> none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sHostName : Host name to lookup the IP address of
'
' Usage:
' ~~~~~~
' GetHostNameIP("utteraccess.com")
' Returns -> 52.40.49.196
' GetHostNameIP("google.com")
' Returns -> 2607:f8b0:4006:813::200e,172.217.10.238
'
' Revision History:
' Rev Date(yyyy-mm-dd) Description
' **************************************************************************************
' 1 2020-11-16 Initial Release
' Different approach using clipboard
'---------------------------------------------------------------------------------------
Function GetHostNameIP(ByVal sHostName As String) As String
Dim sResult As String
Dim aResult As Variant
Dim i As Long
On Error GoTo Error_Handler
If Len(Trim(sHostName)) = 0 Then GoTo Error_Handler_Exit
'Run the nslookup command and save its results to a the clipboard
CreateObject("Wscript.Shell").Run "cmd /c nslookup " & sHostName & "|clip", 0, True
'Retrieve the results from the clipboard
With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.GetFromClipboard
sResult = .GetText
End With
'Breakdown the results, line by line
aResult = Split(sResult, vbCrLf)
If UBound(aResult) > 2 Then
For i = 4 To UBound(aResult)
If Len(Trim(aResult(i) & vbNullString)) > 0 Then
GetHostNameIP = GetHostNameIP & Trim(Replace(Replace(Replace(aResult(i), "Address:", ""), _
"Addresses:", ""), vbTab, "")) & ","
End If
Next i
If Right(GetHostNameIP, 1) = "," Then GetHostNameIP = Left(GetHostNameIP, Len(GetHostNameIP) - 1)
End If
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: GetHostNameIP" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
No flickering, no useless I/O operations.
The nice thing here, is this same principle can be applied to pretty much any DOS command and is application independent as it relies on pure, late bound, VBA.
Looking To Retrieve Your Local Or Public IP Addresses
If you are trying to retrieve your PC’s local or public IP Addresses, then check out:
Note: Small typo ‘to a text file’ should be ‘to clipboard’.
After hunting for a solution that was simple and self contained I decided to use WMI. Its only a few lines of code to get IPv4. A few more to also include IPv6. All assuming that I have made valid assumptions.
My code in case anyone is interested (Omitted error handling to keep it compact)
Public Function getMyIPV1(Optional IPv6 As String)
‘ Returns IPv4 address.
‘ Optionally Passes back IPv6 if exists else an empty string
‘ Ignores all adapters other than those with a default IP gateway value.
‘ We assume that there will only be one resultant record else it will return the last one read
Dim objWMI As Object, objQuery As Object, objQueryItem As Object
Set objWMI = GetObject(“winmgmts:\\.\root\cimv2”)
‘ Select enabled adapters only
Set objQuery = objWMI.ExecQuery(“Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True”)
‘ Loop Thru all enabled adapters
For Each objQueryItem In objQuery
‘ Only adapters with a default gateway are included
If Not IsNull(objQueryItem.DefaultIPGateway) Then
‘ Assume element 0 is IPv4 and 1 is IPv6
getMyIPV2 = objQueryItem.IpAddress(0)
If Not IsMissing(IPv6) Then
If Not IsNull(objQueryItem.IpAddress(1)) Then IPv6 = objQueryItem.IpAddress(1) Else IPv6 = “”
End If
End If
Next
End Function
I’ve seen and tested that approach in the past and sadly it is unreliable. For instance, it does not work on my current PC, so use at your own risk.
Do note your function presents a few issues and won’t return any value, mainly that the line:
should be:
Not sure what the IPv6 string is supposed to do, but as is it won’t do anything.
Also, using
will result in
always being the case. You’d need to switch the input variable to Variant for that test to work or switch to testing
I had a V2 version which returns additional values but created V1 as a simpler version – but failed to test it 🙁
If the optional IPv6 parm is specified then it will return the IPv6 string.
I have re-posted the sub without the comments (for clarity) – its a tested version.
I’m sorry to hear that you have found this method unreliable.
Any idea why it won’t work on your PC? Old PC?
I have now tried it on my W10, Server 2008, and Server 2022 and all return IPv4/6 correctly.
—————————
Public Function getMyIPV1(Optional IPv6 As String)
Dim objWMI As Object, objQuery As Object, objQueryItem As Object
Set objWMI = GetObject(“winmgmts:\\.\root\cimv2”)
Set objQuery = objWMI.ExecQuery(“Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True”)
For Each objQueryItem In objQuery
If Not IsNull(objQueryItem.DefaultIPGateway) Then
getMyIPV1 = objQueryItem.IpAddress(0)
If Not IsMissing(IPv6) Then
If Not IsNull(objQueryItem.IpAddress(1)) Then IPv6 = objQueryItem.IpAddress(1) Else IPv6 = “”
End If
End If
Next
End Function
No, I didn’t get into troubleshooting the issue at the time. All I know is it was returning the IP of a VMare Network Adapter instead of my Wireless LAN adapter.
I found the same as you. I think the line that I added
If Not IsNull(objQueryItem.DefaultIPGateway) Then
cures that.
Looking at the details of all my adapters (quite a few came up) I noticed that the DefaultIPGateway value was only present in my real network adapter so I added that condition.
If my assumption turns out to be wrong then it will be back to the drawing board.
I liked the GetHostNameIP, but it did have some issues with picking up values I didn’t need such as Alias info. Slight modification to look for “Address” in each line fixed it.