Followup: DNS Lookup and Ping in Excel

17 Friday Jan 2014

Posted by C. M. Stephan in CodeProject, RootAdmin, VB

Steve asked on my previous posting in regards to DNS Lookup in Excel if forward lookup could be done. (Find the IP Address from the Hostname). Believe it or not I one up your request. How about DNS Forward and Reverse lookup as well as Ping!

Press Alt-F11 in Excel to get to the VBA screen.
Right click on the Project View
Click Add Module
Add the following snippet.
Use: GetHostname("4.2.2.1") in any Excel cell. or Use: GetIpAddress("www.google.com") in any Excel cell. or Use: Ping("4.2.2.1") in any Excel cell.

Note: If you have lengthy lists of IP addresses you plan on looking up keep in mind that the processs for looking up things against DNS is SLOW in comparison to a normal formula within Excel. Be wise with how you utilize this function.

In cases with duplicate addresses such as a ‘ip flow-cache’ output or ‘ip accounting’ output, you should probably create one lookup table in Excel on a separate tab with a deduplicated list of the IP Addresses with you will attempt loookup in DNS against. Then just use VLOOKUP(IP,HostLookupTable,Col,FALSE) to update the main page.

Once looked up I always copy and paste-as-text so excel doesn’t constantly lookup the list.

Credits: Many Thanks to AlonHircsh and Arkham79 for leaving little gem on experts-echange. It has been modified to include Arkham’s suggestion of including conversion of longIpAddress to stringIpAddress in the function.

Special thanks to chadj2 and Felix for the corrections that resolved the crashes.


' ###################################################################################
' ### Constants and Type Definitions
' ###
Private Const MIN_SOCKETS_REQD As Long = 1
Private Const WS_VERSION_REQD As Long = &H101
Private Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
Private Const SOCKET_ERROR As Long = -1
Private Const WSADESCRIPTION_LEN = 257
Private Const WSASYS_STATUS_LEN = 129
Private Const MAX_WSADescription = 256
Private Const MAX_WSASYSStatus = 128

Private Const IP_SUCCESS As Long = 0
Private Const IP_BUF_TOO_SMALL As Long = 11001
Private Const IP_DEST_NET_UNREACHABLE As Long = 11002
Private Const IP_DEST_HOST_UNREACHABLE As Long = 11003
Private Const IP_DEST_PROT_UNREACHABLE As Long = 11004
Private Const IP_DEST_PORT_UNREACHABLE As Long = 11005
Private Const IP_NO_RESOURCES As Long = 11006
Private Const IP_BAD_OPTION  As Long = 11007
Private Const IP_HW_ERROR As Long = 11008
Private Const IP_PACKET_TOO_BIG As Long = 11009
Private Const IP_REQ_TIMED_OUT As Long = 11010
Private Const IP_BAD_REQ As Long = 11011
Private Const IP_BAD_ROUTE As Long = 11012
Private Const IP_TTL_EXPIRED_TRANSIT As Long = 11013
Private Const IP_TTL_EXPIRED_REASSEM As Long = 11014
Private Const IP_PARAM_PROBLEM As Long = 11015
Private Const IP_SOURCE_QUENCH As Long = 11016
Private Const IP_OPTION_TOO_BIG As Long = 11017
Private Const IP_BAD_DESTINATION As Long = 11018
Private Const IP_GENERAL_FAILURE As Long = 11050

Private Const IP_FLAG_REVERSE As Long = 1
Private Const IP_FLAG_DF As Long = 2
Private Const IP_FLAG_REVERSE_DF As Long = 3

Private Const AF_UNSPEC = 0
Private Const AF_INET = 2
Private Const AF_NETBIOS = 17
Private Const AF_INET6 = 23

Private Type IN_ADDR
    s_b1 As Byte
    s_b2 As Byte
    s_b3 As Byte
    s_b4 As Byte
End Type

Private Type Hostent
    h_name As Long
    h_aliases As Long
    h_addrtype As Integer
    h_length As Integer
    h_addr_list As Long
End Type

Private Type IP_OPTION_INFORMATION
    TTL As Byte
    Tos As Byte
    Flags As Byte
    OptionsSize As Long
    OptionsData As String * 128
End Type

Private Type IP_ECHO_REPLY
    Address As IN_ADDR
    Status As Long
    RoundTripTime As Long
    DataSize As Integer
    Reserved As Integer
    data As Long
    Options As IP_OPTION_INFORMATION
End Type

Private Type WSAdata
    wVersion As Integer
    wHighVersion As Integer
    szDescription(0 To MAX_WSADescription) As Byte
    szSystemStatus(0 To MAX_WSASYSStatus) As Byte
    wMaxSockets As Integer
    wMaxUDPDG As Integer
    dwVendorInfo As Long
End Type

' ###################################################################################
' ### WINSOCK Native Function Imports
' ###
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Sub GetPointer Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, Source As Any, ByVal Length As Long)
Private Declare Sub GetValue Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, ByVal Source As Long, ByVal Length As Long)
Private Declare Function lstrlenA Lib "kernel32" (ByVal Ptr As Any) As Long
Private Declare Function WSACleanup Lib "WSOCK32" () As Long
Private Declare Function WSAStartup Lib "WSOCK32" (ByVal wVersionRequired As Long, lpWSAdata As WSAdata) As Long
Private Declare Function inet_addr Lib "WSOCK32" (ByVal cp As String) As Long
Private Declare Function GetHostByAddr Lib "WSOCK32" Alias "gethostbyaddr" (haddr As Long, ByVal hnlen As Long, ByVal addrtype As Long) As Long
Private Declare Function GetHostByName Lib "WSOCK32" Alias "gethostbyname" (ByVal Hostname As String) As Long
Private Declare Function IcmpCreateFile Lib "icmp" () As Long
Private Declare Function IcmpCloseHandle Lib "icmp" (ByVal HANDLE As Long) As Boolean
Private Declare Function IcmpSendEcho Lib "icmp" ( _
    ByVal IcmpHandle As Long, _
    ByVal DestAddress As Long, ByVal RequestData As String, _
    ByVal RequestSize As Integer, _
    RequestOptns As IP_OPTION_INFORMATION, _
    ReplyBuffer As IP_ECHO_REPLY, _
    ByVal ReplySize As Long, _
    ByVal Timeout As Long _
    ) As Boolean

Private Declare Function WSAGetLastError Lib "WSOCK32" () As Long

' ###################################################################################
' ### Private Utility Functions
' ###
Private Function HiByte(ByVal wParam As Integer)
    HiByte = wParam \ &H100 And &HFF&
End Function

Private Function LoByte(ByVal wParam As Integer)
    LoByte = wParam And &HFF&
End Function

Private Sub SocketsCleanup()
    If WSACleanup() <> ERROR_SUCCESS Then
        'Failed to cleanup sockets.
    End If
End Sub

Private Function SocketsInitialize() As Boolean
    Dim WSAD As WSAdata
    Dim sLoByte As String
    Dim sHiByte As String

    If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then
        'The 32-bit Windows Socket is not responding.
        SocketsInitialize = False
        Exit Function
    End If

    If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
        SocketsInitialize = False
        Exit Function
    End If

    If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
        sHiByte = CStr(HiByte(WSAD.wVersion))
        sLoByte = CStr(LoByte(WSAD.wVersion))
        SocketsInitialize = False
        Exit Function
    End If
    'must be OK, so lets do it
    SocketsInitialize = True
End Function

' ###################################################################################
' ### Exposed Excel Worksheet Functions
' ###
Public Function GetHostName(ByVal Address As String) As String
    Dim lLength As Long
    Dim lRet As Long

    If Not SocketsInitialize() Then
        GetHostName = "WINSOCK_FAILURE"
        Exit Function
    End If

    lRet = GetHostByAddr(inet_addr(Address), 4, AF_INET)
    If lRet <> 0 Then
        CopyMemory lRet, ByVal lRet, 4
        lLength = lstrlenA(lRet)
        If lLength > 0 Then
            GetHostName = Space$(lLength + 1)
            CopyMemory ByVal GetHostName, ByVal lRet, lLength
        End If
    Else
        GetHostName = ""
    End If

    SocketsCleanup
End Function

Public Function GetIpAddress(ByVal Hostname As String) As String
    Dim hHostent As Hostent
    Dim lRet As Long
    Dim ptrAddr As Long
    Dim strIpAddress As String
    Dim Addr As IN_ADDR

    If Not SocketsInitialize() Then
        GetIpAddress = "WINSOCK_FAILURE"
        Exit Function
    End If

    'Get Host IP Address by Name
    lRet = GetHostByName(Hostname + String(64 - Len(Hostname), 0))
    If lRet = 0 Then
        GetIpAddress = "error: " & Str$(WSAGetLastError())
        SocketsCleanup
        Exit Function
    End If
        
    GetValue hHostent.h_name, lRet, Len(hHostent)
    GetValue ptrAddr, ByVal hHostent.h_addr_list, 4

    'Append list of returned IP's
    For ptrAddr = ptrAddr To (ptrAddr + lstrlenA(hHostent.h_addr_list) - 1) Step 4
        GetValue Addr, ptrAddr, 4 'Debug: cast as IP Address
        strIpAddress = strIpAddress + " " + CStr(Addr.s_b1) + "." _
                                          + CStr(Addr.s_b2) + "." _
                                          + CStr(Addr.s_b3) + "." _
                                          + CStr(Addr.s_b4)
    Next

    GetIpAddress = LTrim(strIpAddress)

    SocketsCleanup
End Function

'Returns Error code as String or Round-Trip Response Time in msecs.
Public Function Ping(ByVal Hostname As String, _
                     Optional TTL As Long = 255, _
                     Optional msTimeout As Long = 2000, _
                     Optional packetLength As Long = 32, _
                     Optional DoNotFragment As Boolean = True) As Variant
    Dim hFile As Long
    Dim hHostent As Hostent
    Dim AddrList As Long
    Dim Address As Long
    Dim strIpAddress As String
    Dim OptInfo As IP_OPTION_INFORMATION
    Dim EchoReply As IP_ECHO_REPLY
    Dim StatusString As String
    Dim lRet As Long

    If Not SocketsInitialize() Then
        Ping = "WINSOCK_INIT_FAIL"
        Exit Function
    End If

    'Get Host IP Address by Name
    lRet = GetHostByName(Hostname + String(64 - Len(Hostname), 0))
    If lRet <> SOCKET_ERROR And lRet > 0 Then
        GetValue hHostent.h_name, lRet, Len(hHostent)
        GetValue AddrList, hHostent.h_addr_list, 4
        GetValue Address, AddrList, 4
    Else
        Ping = "NS_SOCKET_ERROR"
        Exit Function
    End If

    'Attempt to Create File Handle to store response in.
    hFile = IcmpCreateFile()
    If hFile = 0 Then
        Ping = "FILE_HANDLE_FAILURE"
        Call WSACleanup 'Terminate WinSock
        Exit Function
    Else
        'Set Options
        OptInfo.TTL = TTL 'Sets Time-to-Live (Limits Router Hops between host and destination)
        OptInfo.Tos = 0 'Silently ignored by WinSock. See: http://support.microsoft.com/kb/248611
        If DoNotFragment Then
            OptInfo.Flags = IP_FLAG_DF
        Else
            OptInfo.Flags = 0
        End If

        'Send ICMP Echo
        If IcmpSendEcho(hFile, Address, String(packetLength, "A"), packetLength, OptInfo, EchoReply, Len(EchoReply) + 8, msTimeout) Then
            strIpAddress = CStr(EchoReply.Address.s_b1) + "." _
                         + CStr(EchoReply.Address.s_b2) + "." _
                         + CStr(EchoReply.Address.s_b3) + "." _
                         + CStr(EchoReply.Address.s_b4)
        End If

        Select Case EchoReply.Status
                    Case IP_SUCCESS
                'The ICMP echo was delivered successfully with the proper response.
                Ping = EchoReply.RoundTripTime

            Case IP_BUF_TOO_SMALL
                'The reply buffer was too small.
                Ping = strIpAddress & ":BUF_TOO_SMALL"

            Case IP_DEST_NET_UNREACHABLE
                'The destination network was unreachable.
                Ping = strIpAddress & ":DEST_NET_UNREACHABLE"

            Case IP_DEST_HOST_UNREACHABLE
                'The destination host was unreachable.
                Ping = strIpAddress & ":DEST_HOST_UNREACHABLE"

            Case IP_DEST_PROT_UNREACHABLE
                'The destination protocol was unreachable.
                Ping = strIpAddress & ":DEST_PROT_UNREACHABLE"

            Case IP_DEST_PORT_UNREACHABLE
                'The destination port was unreachable.
                Ping = strIpAddress & ":DEST_PORT_UNREACHABLE"

            Case IP_NO_RESOURCES
                'Insufficient IP resources were available.
                Ping = strIpAddress & ":NO_RESOURCES"

            Case IP_BAD_OPTION
                'A bad IP option was specified.
                Ping = strIpAddress & ":BAD_OPTION"

            Case IP_HW_ERROR
                'A hardware error occurred.
                Ping = strIpAddress & ":HW_ERROR"

            Case IP_PACKET_TOO_BIG
                'The packet was too big.
                Ping = strIpAddress & ":PACKET_TOO_BIG"

            Case IP_REQ_TIMED_OUT
                'The request timed out.
                Ping = strIpAddress & ":REQ_TIMED_OUT"

            Case IP_BAD_REQ
                'A bad request.
                Ping = strIpAddress & ":BAD_REQ"

            Case IP_BAD_ROUTE
                'A bad route.
                Ping = strIpAddress & ":BAD_ROUTE"

            Case IP_TTL_EXPIRED_TRANSIT
                'The time to live (TTL) expired in transit.
                Ping = strIpAddress & ":TTL_EXPIRED_TRANSIT"

            Case IP_TTL_EXPIRED_REASSEM
                'The time to live expired during fragment reassembly.
                Ping = strIpAddress & ":TTL_EXPIRED_REASSEM"

            Case IP_PARAM_PROBLEM
                'A parameter problem.
                Ping = strIpAddress & ":PARAM_PROBLEM"

            Case IP_SOURCE_QUENCH
                'Datagrams are arriving too fast to be processed and datagrams may have been discarded.
                Ping = strIpAddress & ":SOURCE_QUENCH"

            Case IP_OPTION_TOO_BIG
                'An IP option was too big.
                Ping = strIpAddress & ":OPTION_TOO_BIG"

            Case IP_BAD_DESTINATION
                'A bad destination.
                Ping = strIpAddress & ":BAD_DESTINATION"

            Case IP_GENERAL_FAILURE
                'A general failure. This error can be returned for some malformed ICMP packets.
                Ping = "GENERAL_FAILURE"

            Case Else
                'An unknown error occured.
                Ping = "UNKNOWN_FAILURE"
        End Select
    End If

    Call IcmpCloseHandle(hFile) 'Close File Handle

    SocketsCleanup
End Function

42 thoughts on “Followup: DNS Lookup and Ping in Excel”

zdoe said:

March 9, 2014 at 2:55 am

this looks great, but can’t get it to work. could you provide a walkthrough to a noob? i’ve never done a VBA macro on excel.

Reply
- C. M. Stephan said:
  
  March 11, 2014 at 5:11 am
  
  ill try and take a lookin the morning. If i remember right I hadn’t fully tested that before posting it.. my appologies.
  
  Reply
Lavento said:

March 18, 2014 at 2:24 pm

GetIpAddress works great for DNS-lookups if the DNS you are requesting is correct. If you give hostname which doesn’t exists in the DNS Excel crashes.

Reply
- C. M. Stephan said:
  
  August 23, 2014 at 4:50 pm
  
  I think I have had that issue before… if I remember right, I’m not handling the response (or lack of response) correctly. I actually have a project I’m about to use this for, so once I get it cleaned up I’ll update the post.. expect it sometime late next week. Sorry for the delay.
  
  Reply
PH said:

March 18, 2014 at 3:33 pm

Works very well for me. Excellent work.

Reply
Mitmair said:

April 7, 2014 at 1:18 pm

very nice macro! The only problem is that excel crashes after the third execution of the macro.

Reply
- C. M. Stephan said:
  
  August 23, 2014 at 4:52 pm
  
  Can you provide a list of possibly internet accessible IPs/Hostnames you’re using this on that it fails with as well as which function you are using? I’ll confirm if I’m seeing the same thing. I have recently upgraded to 2013 64-bit, so I’ll test in the upcoming week and get back with you.
  
  Reply
Nithin said:

May 5, 2014 at 8:59 pm

Hey Stephan,
I appreciate the work here, but I was wondering if you got the time to take a look at it. I am asking because I have some problems implementing the code myself.

For PING I get ‘:REQ_TIMED_OUT
For other two ‘GetHostName’ and ‘GetIpAddress’ I simply get blanks as a result to the function.

Reply
piaconis said:

August 5, 2014 at 2:28 pm

Fails on the IP lookup if the host is invalid. I’m running Excel 2013.

Reply
- C. M. Stephan said:
  
  August 23, 2014 at 5:00 pm
  
  Looking into this this week.
  
  Reply
vit said:

August 22, 2014 at 2:32 pm

I’m receiving an error that states: “This application requires a minimum of 1 supported sockets”

Any ideas?

Reply
- C. M. Stephan said:
  
  August 23, 2014 at 4:57 pm
  
  I’m assuming you’re trying to do a reverse lookup on an IP Address using GetHostName.. if so, make sure that you have the TRIM function outside of the GetHostName() Function to remove any extra spaces and that the function is in dotted decimal without leading zeros format. (1.2.3.4 as opposed to 001.002.003.004). Also, the individual octets must be in the range 0-255.
  
  The error is basically notifying you that the underlying WinSock API can’t translate the string into a 32-bit integer. Also I don’t believe this API supports IPv6. Anyways, that’s where I’d start looking.. if you can provide an example function of what you are attempting to do I’ll test it and see if I can’t track down the issue.
  
  Lastly.. and I’m not presuming that you don’t know this just stating it for brevity…. Make sure you have a network connection, valid DNS servers configured on your PC and test with NSLOOKUP from the command prompt to make sure there isn’t some other oddity we’re not thinking of.
  
  Reply
Felix said:

January 29, 2015 at 11:37 am

Great work. Unfortunatly you didn’t post the fix for the crash problem.
I found the error. So for all who wanna fix that do the following steps:

Find the lines with
If lRet SOCKET_ERROR Then
and replace it with
If lRet SOCKET_ERROR And lRet > 0 Then

This fixed it for me.

Reply

chadj2 said:

February 2, 2015 at 10:13 pm

I also ran into the crash problem. I have fixed the code here and added a call to WSAGetLastError so you can get back an error code.

Private Declare Function WSAGetLastError Lib "WSOCK32" () As Long

Public Function GetIpAddress(ByVal Hostname As String) As String
    Dim hHostent As Hostent
    Dim lRet As Long
    Dim ptrAddr As Long
    Dim strIpAddress As String
    Dim Addr As IN_ADDR

    If Not SocketsInitialize() Then
        GetIpAddress = "WINSOCK_FAILURE"
        Exit Function
    End If

    'Get Host IP Address by Name
    lRet = GetHostByName(Hostname + String(64 - Len(Hostname), 0))
    If lRet = 0 Then
        GetIpAddress = "error: " & Str$(WSAGetLastError())
        SocketsCleanup
        Exit Function
    End If
        
    GetValue hHostent.h_name, lRet, Len(hHostent)
    GetValue ptrAddr, ByVal hHostent.h_addr_list, 4

    'Append list of returned IP's
    For ptrAddr = ptrAddr To (ptrAddr + lstrlenA(hHostent.h_addr_list) - 1) Step 4
        GetValue Addr, ptrAddr, 4 'Debug: cast as IP Address
        strIpAddress = strIpAddress + " " + CStr(Addr.s_b1) + "." _
                                          + CStr(Addr.s_b2) + "." _
                                          + CStr(Addr.s_b3) + "." _
                                          + CStr(Addr.s_b4)
    Next

    GetIpAddress = LTrim(strIpAddress)

    SocketsCleanup
End Function

syem said:

March 19, 2015 at 12:45 am

works great on Windows PC, but on a Mac the the referencing to winsock is failing, so I need to know what the Mac equivalent is so I can get it working there too.

Reply
- C. M. Stephan said:
  
  March 20, 2015 at 12:24 am
  
  On Mac OS X you will most likely have to use BSD Sockets. I would have to do some playing in order see how feasible this is. If you have any experience with adding imports to C/C++ function calls, the comparative functions should exist in the header files. The library responsible for these functions at ‘/usr/lib/libc.dylib.’ If I get some time I’ll try and take a look into this. If someone else has a working solution feel free to post in the comments and I’ll update the article.
  
  Good Luck!
  
  Reply
  - Martin said:
    
    October 6, 2015 at 11:38 am
    
    Hello, Stephan,
    any luck? I would like to have nslookup function for Mac excel too ^ ^
Max said:

October 31, 2015 at 5:19 pm

It doesn’t work. I got the message in excel winsockerror. Any ideas?

Reply
Vance Turner said:

November 10, 2015 at 4:30 pm

Is the a way to check the reference cell first for content, and if no content exist, fall out quickly? This would speed it up when the sheet has missing content. I have it tied to a pivot table, and some of the cells have no content because of it missing in the CMDB extract.

Reply
- C. M. Stephan said:
  
  December 16, 2015 at 4:06 am
  
  IF(OR(A1=””,ISBLANK(A1)),””,GetHostname(A1))
  
  Basically if we want to resolve the hostname for the IP Address in A1, we check if the cell is blank or a null string, and then return blank, if this condition does not pass, we perform the lookup and return the result.
  
  Reply
Vance Turner said:

December 15, 2015 at 8:58 pm

Is there a way to speed up the macro? My god it is slow. Painfully, excruciatingly slow when dealing with my row counts. More than 100 is really a problem. And I need to figure how to use this on a spreadsheet with 189067 rows.

Good job on the error cleanup though.

I timed it against a perl module I wrote to do this, and the Perl is much faster. Maybe we can call the perl mod as a macro? Or even Python?

Reply
- C. M. Stephan said:
  
  December 16, 2015 at 4:03 am
  
  So basically if the response has to timeout, winsock can take up to 90 seconds for the request to fail. This leads to a lot of time in spin-wait waiting on the response to come back. The only way to resolve this issue is to wrap this in a parent function and call the lookup asynchronously so we can wait a specific time (shorter than the 90 seconds) and terminate the connection if we don’t get a response back in that time frame. I think I have an example of this elsewhere and if I find it I will post it… otherwise feel free to post anything that you find or blog and I will ref your posting… thanks!
  
  Reply
  - C. M. Stephan said:
    
    December 17, 2015 at 6:39 am
    
    Okay.. I spent a few hours this evening working on several issues posted above while trying to resolve the slowness issue..
    
    I don’t have it completed yet, but I’m working on importing the kernel32 functions for Threading and composing a function to give the appearance of an asynchronous call…. here is what I have gathered thus far..
    
    ' ################################################################################### ' ### Thread Management Functions ' ### Public Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Public Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (lpEventAttributes As SECURITY_ATTRIBUTES, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As Long Public Declare Function SetEvent Lib "kernel32" (ByVal hEvent As Long) As Long Public Declare Function ResetEvent Lib "kernel32" (ByVal hEvent As Long) As Long Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long Public Declare Function GetLastError Lib "kernel32" ()
    Public Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescriptor As Long bInheritHandle As Long End Type Private Const WAIT_OBJECT_0 = 0 Private Const WAIT_ABANDONED = 128 Private Const WAIT_TIMEOUT = 258 Private Const WAIT_FAILED = 4294967295# ' ################################################################################### ' ### Threading Example: ' ### Public EndThread As Boolean 'Triggered Boolean to trap for. Public hEvent As Long 'Storage for created event Public Sub ThreadProc() Dim SA As SECURITY_ATTRIBUTES Dim result As Long EndThread = False SA.nLength = Len(SA) hEvent = CreateEvent(SA, False, False, "") ' Encapsulated in a do loop so we can terminate the thread if necessary ' by setting EndThread to TRUE Do Until EndThread = True result = WaitForSingleObject(hEvent, 1000) If result = WAIT_OBJECT_0 Then MsgBox "EventSignalled", , App.Title ResetEvent hEvent Loop End Sub Private Sub Example_CreateThread() Dim hThread As Long hThread = CreateThread(ByVal 0&, ByVal 0&, AddressOf ThreadProc, ByVal 0&, ByVal 0&, 0&) ' hThreadID) ' Don't need handle, so dispose of it cleanly CloseHandle hThread End Sub Private Sub Example_SignalEvent() ' Signal the Event to trap ThreadProc function. SetEvent hEvent End Sub
    Private Sub Terminate_Thread() ' Ensure we terminate thread when closing. This is particularly important in IDE, ' as otherwise we WILL crash ' This still isn't perfect, as there is still the possibility that the thread ' is in a wait state when we exit EndThread = True End Sub
  - Turner, Vance said:
    
    December 17, 2015 at 6:21 pm
    
    Awesome….:)
  - Turner, Vance said:
    
    December 18, 2015 at 7:42 pm
    
    CM, trying to add a little debug. Trying the following to get the results below.
    
    ‘ ###################################################################################
    ‘ ### Exposed Excel Worksheet Functions
    ‘ ###
    Public Function GetHostName(ByVal Address As String) As String
    Dim lLength As Long
    Dim lRet As Long
    Dim dwError As Long
    Dim WSAD As WSAdata
    
    If Not SocketsInitialize() Then
    GetHostName = “WINSOCK_FAILURE”
    Exit Function
    End If
    
    lRet = GetHostByAddr(inet_addr(Address), 4, AF_INET)
    If lRet 0 Then
    CopyMemory lRet, ByVal lRet, 4
    lLength = lstrlenA(lRet)
    If lLength > 0 Then
    GetHostName = Space$(lLength + 1)
    CopyMemory ByVal GetHostName, ByVal lRet, lLength
    End If
    Else
    dwError = WSAGetLastError()
    If dwError > 0 Then
    If dwError = WSAHOST_NOT_FOUND Then
    GetHostName = “Host not found”
    Exit Function
    ElseIf dwError = WSANO_DATA Then
    GetHostName = “No data record found”
    Exit Function
    Else
    GetHostName = “Function failed with error: ” & dwError
    Exit Function
    End If
    End If
    End If
    
    SocketsCleanup
    End Function
    
    Trying to return something like Nslookup returns
    
    “frablox2.staples.com can’t find 147.225.162.174: Non-existent domain”
  - Turner, Vance said:
    
    December 18, 2015 at 8:18 pm
    
    I was debugging and found this reference that ties back to part of the delay.
    
    Seems gethostbyaddr has some long internal loop.
    
    https://msdn.microsoft.com/en-us/library/windows/desktop/ms738521%28v=vs.85%29.aspx
    
    gethostbyaddr is no longer recommended for use as of Windows Sockets 2. Instead, use getnameinfo.
  - C. M. Stephan said:
    
    December 19, 2015 at 5:45 pm
    
    Interesting find. I’m not at my workstation at the moment, but I take a look when I get back on what it would take to import getnameinfo() instead. If the function provides the ability to specify timeout this could be a munch simpler approach than to try to implement threads in vba.
  - Turner, Vance said:
    
    December 21, 2015 at 2:16 pm
    
    Also, I am running the debugger, and it seems you are initializing the socket numerous times. Still trying to figure this out exactly.
  - Turner, Vance said:
    
    December 21, 2015 at 6:26 pm
    
    Yes, the debug shows that it steps into the routine for Public Function GetHostByName and the longest point in the function is when it calls GetHostByAddr. Over a second per resolution.
  - Turner, Vance said:
    
    December 21, 2015 at 8:11 pm
    
    I think we should look at adding a while loop so that we can background the socket operation and set it to say 128 or 256 workers wide. So that the 90K request should resolve in somewhere around 11 minutes. Serially, makes no sense from a bulk time analysis for large row counts.
  - Turner, Vance said:
    
    December 21, 2015 at 3:28 pm
    
    I rewrote the code as follows to see the error, but even though GetHostByAddr returns 0
    So does WSAGetLastError(). It’s driving me batty…
    
    The problem is that the entry I am testing has no reverse lookup value, and I want that to be returned.
    
    ‘ ###################################################################################
    ‘ ### Exposed Excel Worksheet Functions
    ‘ ###
    Public Function GetHostName(ByVal Address As String) As String
    Dim lLength As Long
    Dim lRet As Long
    Dim dwError As Long
    Dim WSAD As WSAdata
    
    If Not SocketsInitialize() Then
    GetHostName = “WINSOCK_FAILURE”
    Exit Function
    End If
    
    lRet = GetHostByAddr(inet_addr(Address), 4, AF_INET)
    dwError = WSAGetLastError()
    If lRet = 0 Then
    If dwError > 0 Then
    If dwError = WSAHOST_NOT_FOUND Then
    GetHostName = “Host not found”
    Exit Function
    ElseIf dwError = WSANO_DATA Then
    GetHostName = “No data record found”
    Exit Function
    Else
    GetHostName = “Function failed with error: ” & dwError
    Exit Function
    End If
    End If
    Else
    CopyMemory lRet, ByVal lRet, 4
    lLength = lstrlenA(lRet)
    If lLength > 0 Then
    GetHostName = Space$(lLength + 1)
    CopyMemory ByVal GetHostName, ByVal lRet, lLength
    End If
    End If
    
    SocketsCleanup
    End Function
  - Turner, Vance said:
    
    December 21, 2015 at 3:37 pm
    
    This might be a useful code snippet.
    
    http://stackoverflow.com/questions/2215203/vb6-lookup-hostname-from-ip-specifying-dns-server
Vance Turner said:

December 29, 2015 at 1:40 pm

So for some reason I am getting the errors, just not what one would expect. I am getting windows 32 error codes for 0 and 5.

Now how the hell I get 0 and no data from DNS is a mystery in itself, but who ever said Microsoft did anything correctly.

So we can clean up that error routine a bit, and it works.

I was trying to find a way to tie it back to these message breakdowns, but I can seem to do it like I would in Unix/Linux

Any suggestions?

Also Excel seems to start at the last cell and work back to the top, that is not how it explained from Excel manual pages.

ERROR_SUCCESS

0 (0x0)

The operation completed successfully.

ERROR_ACCESS_DENIED

5 (0x5)

Access is denied.

Reply
- C. M. Stephan said:
  
  August 19, 2016 at 1:23 pm
  
  It is actually possible to get an empty response for example if you performed a forward lookup which resolves to a CNAME record, which points to a nonexistent A record. In this case, the DNS response will be empty. However, if you’re doing a reverse look up–translating an IP address into a name–it does seem rather unlikely that a PTR record would exist with an empty record.
  
  You have contributed a lot of work to resolve this. I’ll commit some time towards the effort and do some deciding on your code this afternoon.
  
  Thank you for contributing so much of your time.
  
  Reply
Vance Turner said:

December 29, 2015 at 1:59 pm

Maybe someone can help me with this, I am trying to use the FormatMessage to decode the return code and stick that in what is returned by GetHostName

http://www.developer.com/net/vb/article.php/10926_1537091_9/Visual-Basic-6-Win32-API-Tutorial.htm

Reply
TekProGS said:

December 29, 2015 at 8:46 pm

Hey guys,
I have about 100 rows of IP in one column. I create the macro with program. when I do getHostname(“ip) – it gives the required output however I was not sure how it can do it from all 100 ips at once. do I manually need to add =GetHostname(“ip”) on each ip address or is there way to do that differently? please help!

Reply
- C. M. Stephan said:
  
  January 28, 2016 at 11:31 pm
  
  Yes you can perform a lookup on 100 rows at once, however you may note that it can take significant time to return the data as each row will be processed in order. Try the following:
  
  1. Enter the IP addresses you wish to lookup in Column A starting with A1.
  
  2. Enter the following formula in B1: =GetHostname(A:A)
  
  3. Copy Cell B1 and select all of the adjacent cells in column B to cells in column A which have IP addresses in them and paste the already copied cell into these now selected cells.
  This should result in a long process where each cell is evaluated one by one resulting either in timeout or the hostname of the IP address populating each cell.
  
  Make sure you are patient as if you click on the excel window during this process it can crash excel due to the single threaded synchronous nature of VBA. We hope to resolve this issue soon as I’m currently working on making this process asynchronous.
  
  Reply
  - TekproGS said:
    
    March 29, 2016 at 12:57 pm
    
    Thanks C.M. Were you able to make it asynchronous?
cmh said:

June 8, 2018 at 6:32 pm

I realize this post is old but I have been using this VBA snippet for quite awhile & have really appreciated its usefulness.

However, I have recently tried to use it in Excel 2013 and all attempts to use these functions result in #VALUE!. I’ve enabled macros in trust center and even opened existing macro enabled workbooks with this code in it which also now fails. Any ideas how to make this run in Excel 2013?

Thanks!

Reply
cmh said:

September 14, 2018 at 3:54 pm

bump

Reply
lifesvic said:

May 11, 2019 at 9:45 am

Did you ever update the code for 64-bit use? 🙂

Reply
- C. M. Stephan said:
  
  July 21, 2019 at 5:38 pm
  
  I have not.. unfortunately, I have migrated off of Windows and Office (Excel) in my daily tasks, however if someone were to have a working solution I would gladly share it here.
  
  Reply