Solved: VBA - Excel - XP - Ping

[mrdata030]

How do I ping a domain name within ms excel xp and then copy the ip address into a cell of the same worksheet?

[Justinlabenne]

Try this entry and see if it works for you:

[Killian]

Hi and welcome to VBAX

I'm not sure VBA has the means to do this directly, since some kind of Internet Connection Protocal would need to be established.
That's not to say it can't be done from Excel, you'll just need to get creative with some Win API functions.
Here's some code that does the job... I've added some comments to attempt to explain what's going on. The main routine just calls the main function, passing the web addy you want to ping. I've set the main function up to return a string in the format ip_address,time(in milliseconds) so you can use the Split function to write this to cells.[VBA]Dim c As Range

'Range("A1:A10") contains the domain names to ping
For Each c In ActiveSheet.Range("A1:A10")
ActiveSheet.Range(c.Offset(0, 1), c.Offset(0, 2)) = _
Split(PingAddress(c.Text), ",")
Next c[/VBA]It's probably worth pointing out if you have a firewall, there may be some complaints, depending on how it's configured. It's also quite simple so some nested DNS lookups (for sites set up as portals) might return failures. Worth a try, though
[VBA]Option Explicit

'required WIN API functions
Private Declare Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal strDomainName As String) As Long
Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSAdata As WSAdata) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
Private Declare Function IcmpCloseHandle Lib "icmp.dll" (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

'declare data structures
Private Type WSAdata 'for wsock32.dll data
wVersion As Integer
wHighVersion As Integer
szDescription(0 To 255) As Byte
szSystemStatus(0 To 128) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type
Private Type Hostent 'for memory copy
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 ' optional ICMP info
TTL As Byte
Tos As Byte
Flags As Byte
OptionsSize As Long
OptionsData As String * 128
End Type
Private Type IP_ECHO_REPLY 'ICMP return data
Address(0 To 3) As Byte
Status As Long
RoundTripTime As Long
DataSize As Integer
Reserved As Integer
data As Long
Options As IP_OPTION_INFORMATION
End Type

Function PingAddress(strDomainName) As String

'declare return types
Dim hFile As Long
Dim lpWSAdata As WSAdata
Dim hHostent As Hostent
Dim AddrList As Long
Dim Address As Long
Dim rIP As String
Dim OptInfo As IP_OPTION_INFORMATION
Dim EchoReply As IP_ECHO_REPLY

'startup wsock32.dll
Call WSAStartup(&H101, lpWSAdata)

If GetHostByName(strDomainName) <> 0 Then
CopyMemory hHostent.h_name, ByVal GetHostByName(strDomainName), Len(hHostent)
CopyMemory AddrList, ByVal hHostent.h_addr_list, 4
CopyMemory Address, ByVal AddrList, 4
Else
PingAddress = "Error, Unable to get host name"
Exit Function
End If

'return handle to new file to hold Internet Control Message Protocol data
hFile = IcmpCreateFile()
If hFile = 0 Then
PingAddress = "Error, Unable to Create File Handle"
Exit Function
End If

'TTL is the Time To Live, i.e. number of hops the request will make before failure
OptInfo.TTL = 255

'send the request - return data to structures declared above
If IcmpSendEcho(hFile, Address, String(32, "A"), 32, OptInfo, EchoReply, Len(EchoReply) & 8, 2000) Then
rIP = CStr(EchoReply.Address(0)) & "." & CStr(EchoReply.Address(1)) & "." & CStr(EchoReply.Address(2)) & "." & CStr(EchoReply.Address(3))
Else
PingAddress = "Error, Timeout"
End If
If EchoReply.Status = 0 Then
PingAddress = rIP & "," & Trim$(CStr(EchoReply.RoundTripTime)) & "ms"
Else
PingAddress = "Error, Failure"
End If

'close handle to datafile and close wsock32.dll
Call IcmpCloseHandle(hFile)
Call WSACleanup

End Function

Sub VBPing()
'example of use
MsgBox PingAddress("www.google.com")

End Sub[/VBA]

[sheeeng]

Wow, new ideas here...

Btw, can we use VBA to entablish TCP/IP connections? eg. ECHO client server type?

[MOS MASTER]

Nice one Killian!

Perhaps this one could be helpfull as well:
http://www.vbaexpress.com/kb/getarticle.php?kb_id=537

HTH,

[Justinlabenne]

Hey Joost, thats the same kb entry I posted.
The link is just formatted as text to throw you off.

Later buddy.......

[MOS MASTER]

Hey Joost, thats the same kb entry I posted.
The link is just formatted as text to throw you off.

Later buddy.......

Hahahaa... sorry buddy!

[mrdata030]

I have that but I am trying to have it get website address fromwithin my excel spreadsheet starting from cell a1 and going to until their is data to be gotten and then place the ip address into the cell c1

[mrdata030]

Ok, but that code at the end as it says displays a message box with the info. Now I am trying to capture what to ping in cell a2 and place the results in b2 and ping the mail server and place those results in c2
[VBA]
Sub VBPing()
'example of use
MsgBox PingAddress("www.google.com")

End Sub
[/VBA]

[Killian]

Well there's another example of what you want to do preceding the main code - you just need to change the reference to the range that contains the domain names

[mrdata030]

[VBA]

Dim c As Range

'Range("A1:A10") contains the domain names to ping
For Each c In ActiveSheet.Range("A1:A10")
ActiveSheet.Range(c.Offset(0, 1), c.Offset(0, 2)) = _
Split(PingAddress(c.Text), ",")
Next c
[/VBA]
Sorry i did not look at that script at first. That works well, the only 2 things is that I am also trying to do a mail lookup and I only want the ip addresses pasted not the time frame. Any suggestions.

[mrdata030]

I will as soon as it is.

[Killian]

So, to return just the IP, change this line in the main function:
PingAddress = rIP & "," & Trim$(CStr(EchoReply.RoundTripTime)) & "ms"

to this:
PingAddress = rIP

Now you don't need to Split the returned string and you're only assigning it to a single cell so that routine becomes a little simpler
[VBA]For Each c In ActiveSheet.Range("A1:A10")
ActiveSheet.Range(c.Offset(0, 1)).Value = PingAddress
Next c[/VBA]

Regarding the next part... what do you mean by a Mail lookup? Communicating with a mail server is a different ballgame... Pinging the domain name will tell you that the server's responding - if it's also a mail server you would have to use Simple Mail Transfer Protocol (SMTP) to interrogate port 25 to get a response on the mail capabilities. However, I don't think this is possible in the same way - The WinAPI doesn't have an SMTP library so you would need to use some 3rd party library.

[mrdata030]

I am trying to do the same thing for the mail server. I.E. ping mail.domainname.com and copy the ip to the cell. Now I tried what you wrote and its hung up on pingaddress. What exactly should I write for the code.

[Killian]

Well the code I posted seems to work fine for my tests... using the address format "mail.domainname.com" will only work if the mailserver is registered as a sub-domain in that way - which isn't always the case.
Can you describe what you mean by "hung-up"? the IcmpSendEcho call passes the timeout as it's last parameter, 2000ms in the posted code, so if there's no response after 2 seconds, you should get "Error, Timeout" written out as the result.
You could try stepping through the code line by line with F8 to see what's going on.
If it's not working out, post a sample list of servers (or you can send the workbook with the code you're trying, if you like) and I'll try to figure something out.

[mrdata030]

Qoute:

"For Each c In ActiveSheet.Range("A1:A10")
ActiveSheet.Range(c.Offset(0, 1)).Value = PingAddress
Next c "

When I use this it always has a problem with the PingAddress command.

So i decided just to learn to use nslookup against 3 name servers, any ideas

[Killian]

My idea is, that saying something has a problem doesn't adequately describe what's happening, so it will be diffucult to resolve it.
I'm not so sure that giving up and learning to use nslookup is going to help either... nslookup is a windows executable that actually uses the GetHostByName WinAPI function we used in the PingAddress function - I don't see how you can use it to get a return value in Excel.

I've attached an example that works for me - open and run the "GetIPs" marco at let me know exactly what happens... I'm intrigued (and also I don't like to give up, it's only code, after all)

[mrdata030]

My idea is, that saying something has a problem doesn't adequately describe what's happening, so it will be diffucult to resolve it.
I'm not so sure that giving up and learning to use nslookup is going to help either... nslookup is a windows executable that actually uses the GetHostByName WinAPI function we used in the PingAddress function - I don't see how you can use it to get a return value in Excel.

I've attached an example that works for me - open and run the "GetIPs" marco at let me know exactly what happens... I'm intrigued (and also I don't like to give up, it's only code, after all)

I didn't see any attachements? The reason I have decided to use nslookup instead is because I am finding alot of the domains no longer resolving but I still need to find internally what servers they are on.

[Killian]

forgot the attachment

[mrdata030]

Ok, that worked but that script was different then what you posted. this is the results:

Error, Unable to get host name82.165.237.33,34ms82.165.237.33,32msError, Failure64.202.167.129,61ms216.149.215.5,48ms207.234.151.47,65ms65.163.26.135,52msError, Unable to get host name65.163.26.164,32msError, Failure65.163.26.164,31msError, Unable to get host nameError, Unable to get host name65.73.235.127,87ms65.163.26.164,31ms65.163.26.164,31msError, FailureError, Unable to get host name64.202.167.192,61msError, Unable to get host name65.163.26.136,32msError, Unable to get host nameError, Unable to get host name68.142.234.44,29ms65.163.26.98,52msError, Failure64.202.167.129,60ms

Now I am trying to do an internal lookup of these domains so I dont what the errors and I dont want the ms