Link to home
Start Free TrialLog in
Avatar of bsharath
bsharathFlag for India

asked on

Machine names in Colum "Q".Need the ip's of the machines in Colum "AS"

Hi,

Machine names in Colum "Q".Need the ip's of the machines in Colum "AS"
Need this to update the colum cells once the macro is Run.
Need the macro to be as fast as possible.
As i have 1000's of machine names in colum "Q"

Regards
Sharath
Avatar of MaduKp
MaduKp
Flag of Sri Lanka image

Do u just need to replace the column 'Q' value by the values of column 'AS'?
Here the macro for that.
If this is not the case, Let me know what exactly your requirement.
Sub Macro1()
    Columns("Q:Q).Select
    Selection.Copy
    Columns("AS:AS").Select
    ActiveSheet.Paste
End Sub
Avatar of bsharath

ASKER

No..

I have the machinenames in the colum.Need to ping each machine and get the ipaddress.
Like
120.10.10.10
Is there a way to retrieve the machine ip's in a fast way...to the "AS" Colum
Avatar of Jorge Paulino
I don't know the time that it takes but you can use this:
https://www.experts-exchange.com/questions/22838997/Ping-from-Excel.html
I just tried but get compiling error in lots of places.

>> I just tried but get compiling error in lots of places.

Error in the compiling  ??? This code must be entered inside of a module.
Yes i inserted a new module.And pasted the code inside the module.
And the IP's are internet IP's or from a local network ? Can we see the file ?
Ip's are local Lan ip's...

Hi, i think this will solve your problem

use the following code , to resolve and put the results in column AS
you can modify the range (Q1:Q1000) as per your requirment
and the Offset to adjust the target column

the following function is used to resolve hostname to IP , and it is included at the end of the code

Public Sub DoResolve()

   Dim Cell As Range
   Dim Result As Long
   
   For Each Cell In Range("Q1", "Q1000")
      Result = GetIPAddressFromHostName(Cell)
      Cell.Offset(0, 28) = GetStringFromIPAddress(Result)
   Next Cell

End Sub


' TCP/IP networking routines for pinging hosts, resolving host names and IP
' addresses, and checking for network connectivity.
 
Option Explicit
 
Private Const INTERNET_CONNECTION_LAN As Long = &H2
Private Const INTERNET_CONNECTION_MODEM As Long = &H1
Private Const MAX_WSADescription As Long = 256
Private Const MAX_WSASYSStatus As Long = 128
Private Const WS_VERSION_REQD As Long = &H101
Private Const AF_INET As Long = 2
Private Const PING_TIMEOUT As Long = 1000
Private Const IP_STATUS_BASE As Long = 11000
Private Const IP_REQ_TIMED_OUT As Long = (IP_STATUS_BASE + 10)
 
Public Enum tPingError
   PingError_InvalidTarget = 0
   PingError_Timeout = -1
   PingError_Other = -2
End Enum
 
Private Type ICMP_OPTIONS
   Ttl As Byte
   Tos As Byte
   Flags As Byte
   OptionsSize As Byte
   OptionsData As Long
End Type
 
Private Type ICMP_ECHO_REPLY
   Address As Long
   status As Long
   RoundTripTime As Long
   DataSize As Long
   DataPointer As Long
   Options As ICMP_OPTIONS
   Data As String * 250
End Type
 
Private Type WSADATA
   wVersion As Integer
   wHighVersion As Integer
   szDescription As String * MAX_WSADescription
   szSystemStatus As String * MAX_WSASYSStatus
   iMaxSockets As Integer
   iMaxUdpDg As Integer
   lpVendorInfo As Long
End Type
 
Private Type HOSTENT
   hName As Long
   hAliases As Long
   hAddrType As Integer
   hLen As Integer
   hAddrList As Long
End Type
 
Private Declare Function InternetGetConnectedState Lib "wininet.dll" ( _
      ByRef lpdwFlags As Long, _
      ByVal dwReserved As Long _
   ) As Long
 
Private Declare Function gethostbyaddr Lib "wsock32" ( _
      haddr As Long, _
      ByVal hnlen As Long, _
      ByVal addrtype As Long _
   ) As Long
 
Private Declare Function gethostbyname Lib "wsock32" ( _
      ByVal HostName As String _
   ) As Long
 
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
      ByRef Destination As Any, _
      ByRef Source As Any, _
      ByVal Length As Long _
   )
 
Public Declare Function WSAStartup Lib "wsock32" _
   (ByVal wVersionRequired As Long, _
    lpWSADATA As WSADATA) As Long
   
Public Declare Function WSACleanup Lib "wsock32" () As Long
 
Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
 
Private Declare Function IcmpCloseHandle Lib "icmp.dll" ( _
      ByVal IcmpHandle As Long _
   ) As Long
   
Private Declare Function IcmpSendEcho Lib "icmp.dll" ( _
   ByVal IcmpHandle As Long, _
   ByVal DestinationAddress As Long, _
   ByVal RequestData As String, _
   ByVal RequestSize As Long, _
   ByVal RequestOptions As Long, _
   ReplyBuffer As ICMP_ECHO_REPLY, _
   ByVal ReplySize As Long, _
   ByVal Timeout As Long) As Long
 
Public Function GetFullHostNameFromHostName( _
      ByVal HostName As String _
   ) As String
 
' Return the full host name from a host name.
 
   Dim HostEntry As HOSTENT
   Dim HostEntryPtr As Long
   Dim IPAddressesPtr As Long
   Dim Result As String
 
   If InitializeSockets Then
      HostEntryPtr = gethostbyname(HostName & vbNullChar)
      If HostEntryPtr > 0 Then
         CopyMemory HostEntry, ByVal HostEntryPtr, Len(HostEntry)
         Result = Space(256)
         CopyMemory ByVal Result, ByVal HostEntry.hName, 256
         Result = Left(Result, InStr(Result, vbNullChar) - 1)
         GetFullHostNameFromHostName = Result
      End If
   End If
   
End Function
 
Private Function GetHostNameFromIPAddress( _
      ByVal IPAddress As Variant _
   ) As String
 
   Dim HostEntry As HOSTENT
   Dim HostEntryPtr As Long
   Dim Result As String
   
   If InitializeSockets Then
      If VarType(IPAddress) <> vbLong Then IPAddress = GetIPAddressFromString(IPAddress)
      HostEntryPtr = gethostbyaddr(IPAddress, 4, AF_INET)
      If HostEntryPtr > 0 Then
         CopyMemory HostEntry, ByVal HostEntryPtr, Len(HostEntry)
         Result = Space(256)
         CopyMemory ByVal Result, ByVal HostEntry.hName, 256
         Result = Left(Result, InStr(Result, vbNullChar) - 1)
         GetHostNameFromIPAddress = Result
      End If
   End If
     
End Function
 
Public Function GetIPAddressFromHostName( _
      ByVal HostName As String _
   ) As Long
 
' Return the IP address from a host name as a long. Use GetStringFromIPAddress
' to format the IP address as an octet string.
 
   Dim HostEntry As HOSTENT
   Dim HostEntryPtr As Long
   Dim IPAddressesPtr As Long
   Dim Result As Long
 
   If InitializeSockets Then
      HostEntryPtr = gethostbyname(HostName & vbNullChar)
      If HostEntryPtr > 0 Then
         CopyMemory HostEntry, ByVal HostEntryPtr, Len(HostEntry)
         CopyMemory IPAddressesPtr, ByVal HostEntry.hAddrList, 4
         CopyMemory Result, ByVal IPAddressesPtr, 4
         GetIPAddressFromHostName = Result
      End If
   End If
   
End Function
 
Public Function GetIPAddressFromString( _
      ByVal IPAddress As String _
   ) As Long
 
' Return the long form of the string IP address.
 
   Dim Octets As Variant
   Dim HexString As String
   Dim Index As Long
   
   Octets = Split(IPAddress, ".")
   If UBound(Octets) <> 3 Then Exit Function
   For Index = 0 To 3
      If Not IsNumeric(Octets(Index)) Then Exit Function
   Next Index
   
   GetIPAddressFromString = Octets(0) + Octets(1) * 256 ^ 1 + Octets(2) * 256 ^ 2 + Octets(3) * 256 ^ 3
 
End Function
 
Public Function GetNormalizedIPAddress( _
      ByVal Text As String, _
      Optional ByVal ZeroPadOctets As Long = 0 _
   ) As String
   
' Convert the text to an IP address. Text can be any value or an eight
' character hexidecimal number. Examples:
'
'  0 -> 0.0.0.0
'  255.10 -> 255.10.0.0
'  FFFE0001 -> 255.254.0.1
'  258.-1.0.0 -> 255.0.0.0
'
' Use the parameter ZeroPadOctets to pad each octet with zeros. Pass a
' positive integer from 1 to 4 to pad that number of octets starting from
' the left. Pass a negative integer from -1 to -4 to pad that number of
' octets starting from the right.
 
   Dim Nodes As Variant
   Dim Index As Long
   Dim Result As String
 
   If Len(Text) > 0 Then
      Nodes = Split(Text, ".")
      If UBound(Nodes) = 0 And Len(Nodes(0)) = 8 Then
         ReDim Nodes(0 To 3)
         For Index = 0 To 3
            Nodes(Index) = CStr(CLng("&H" & Mid(Text, Index * 2 + 1, 2)))
         Next Index
      End If
      For Index = 0 To UBound(Nodes)
         If Not IsNumeric(Nodes(Index)) Then Nodes(Index) = 0
         Nodes(Index) = Application.Max(0, Application.Min(255, Nodes(Index)))
      Next Index
      Result = Join(Nodes, ".") & Left(".0.0.0", 6 - UBound(Nodes) * 2)
      Nodes = Split(Result, ".")
      If ZeroPadOctets > 0 Then
         For Index = 0 To 3
            If Index + 1 <= ZeroPadOctets Then Nodes(Index) = Right("00" & Nodes(Index), 3)
         Next Index
      Else
         For Index = 0 To 3
            If 4 - Index <= -ZeroPadOctets Then Nodes(Index) = Right("00" & Nodes(Index), 3)
         Next Index
      End If
      GetNormalizedIPAddress = Join(Nodes, ".")
   End If
 
End Function
 
Public Function GetStringFromIPAddress( _
      ByVal IPAddress As Long _
   ) As String
 
' Return the string form of the IP address.
 
   Dim IPAddressString As String
   Dim Index As Long
   
   IPAddressString = Space(4)
   CopyMemory ByVal IPAddressString, IPAddress, 4
 
   GetStringFromIPAddress = _
      Asc(Mid$(IPAddressString, 1, 1)) _
      & "." _
      & Asc(Mid$(IPAddressString, 2, 1)) _
      & "." _
      & Asc(Mid$(IPAddressString, 3, 1)) _
      & "." _
      & Asc(Mid$(IPAddressString, 4, 1))
 
End Function
 
Public Function InitializeSockets() As Boolean
 
' Initialize Windows sockets.
 
   Dim WinSockData As WSADATA
   
   InitializeSockets = WSAStartup(WS_VERSION_REQD, WinSockData) = 0
   
End Function
 
Public Function IsInternetConnectionDialUp() As Boolean
 
' Return True if a dial up Internet connection is active, False otherwise.
 
   Dim Result As Boolean
   Dim Flags As Long
   
   Result = InternetGetConnectedState(Flags, 0&)
   If (Flags And INTERNET_CONNECTION_MODEM) > 0 Then
      IsInternetConnectionDialUp = True
   End If
 
End Function
 
Public Function IsInternetConnectionLAN() As Boolean
 
' Return True if a LAN Internet connection is active, False otherwise.
 
   Dim Result As Boolean
   Dim Flags As Long
   
   Result = InternetGetConnectedState(Flags, 0&)
   If (Flags And INTERNET_CONNECTION_LAN) > 0 Then
      IsInternetConnectionLAN = True
   End If
 
End Function
 
Public Function IsInternetConnectionOnline() As Boolean
 
' Return True is an Internet connection is available, False otherwise.
 
   Dim Result As Boolean
   Dim Flags As Long
   
   Result = InternetGetConnectedState(Flags, 0&)
   If Result Then
      IsInternetConnectionOnline = True
   End If
 
End Function
 
Public Function IsServerAvailable( _
      ByVal Path As String _
   ) As Boolean
 
' Return true if the server or path is available, False otherwise. If the
' server is not local and is not available the response time can be five
' to ten seconds.
 
   On Error Resume Next
   ChDir Path
   IsServerAvailable = Err <> 76
 
End Function
 
Public Function Ping( _
      ByVal Target As Variant, _
      Optional ByVal Data As String = " " _
   ) As tPingError
 
' Ping the target and return the round trip time in milliseconds or a negative
' value describing the failure. Target can be a host name, string IP address,
' or long IP address.
 
   Dim IPAddress As Long
   Dim Port As Long
   Dim EchoReply As ICMP_ECHO_REPLY
 
   Select Case VarType(Target)
      Case vbLong
         IPAddress = Target
      Case vbString
         IPAddress = GetIPAddressFromString(Target)
         If IPAddress = 0 Then
            IPAddress = GetIPAddressFromHostName(Target)
            If IPAddress = 0 Then
               Ping = PingError_InvalidTarget
               Exit Function
            End If
         End If
      Case Else
         Stop ' Target must be a string or a long
   End Select
   
   ' Initialize Windows sockets
   If Not InitializeSockets Then
      Ping = PingError_Other
      Exit Function
   End If
   
   ' Open a port
   Port = IcmpCreateFile()
   If Port = 0 Then
      TerminateSockets
      Ping = PingError_Other
      Exit Function
   End If
   
   ' Ping the IP adddress
   IcmpSendEcho Port, IPAddress, Data, Len(Data), 0, EchoReply, Len(EchoReply), PING_TIMEOUT
   
   ' Evaluate ping response
   If EchoReply.status = IP_REQ_TIMED_OUT Then
      Ping = PingError_Timeout
   ElseIf EchoReply.status <> 0 Then
      Ping = PingError_Other
   Else
      Ping = EchoReply.RoundTripTime
   End If
   
   ' Cleanup
   IcmpCloseHandle Port
   TerminateSockets
 
End Function
 
Public Sub TerminateSockets()
 
' Terminate Windows sockets.
   
   WSACleanup
   
End Sub
 
Public Sub DoResolve()
 
   Dim Cell As Range
   Dim Result As Long
   
   For Each Cell In Range("Q1", "Q1000")
      Result = GetIPAddressFromHostName(Cell)
      Cell.Offset(0, 28) = GetStringFromIPAddress(Result)
   Next Cell
 
End Sub

Open in new window



This file ia a working example


Resolver.xls
dr_ggm
Thanks for this.It works fine.But need a little tweeking.
If the Colum Q has a cell blank it gives some ip address.
The ip's go until row 999.Can we change it to get ip's for just machines that are there.And leave the rest blank
Can i have a finish button at the end when it finishes the job.
dr_ggm
Thanks for this.It works fine.But need a little tweeking.
If the Colum Q has a cell blank it gives some ip address.
The ip's go until row 999.Can we change it to get ip's for just machines that are there.And leave the rest blank
Can i have a finish button at the end when it finishes the job.
Try to change for routine:

Public Sub DoResolve()

   Dim Cell As Range
   Dim Result As Long
   Dim x As Long
   
   For x = 1 To Cells(65536, 17).End(xlUp).Row
      Result = GetIPAddressFromHostName(Cells(x, 17))
      Cells(x, 18) = GetStringFromIPAddress(Result)
   Next x

End Sub
After change .When i run the macro.There is no output...
After change .When i run the macro.There is no output...
>> After change .When i run the macro.There is no output...

right click on the button and check if it's calling the righ sub
>> After change .When i run the macro.There is no output...

right click on the button and check if it's calling the right sub
Sorry Sorry..
Can you please attach the file...
ASKER CERTIFIED SOLUTION
Avatar of Jorge Paulino
Jorge Paulino
Flag of Portugal image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial


Dear bsharath
Check this file

Run the macro to do the required task (resolve, ping or both) on the selected range

replace Selection  with  Range("Q2", "Q100")  in the function to refer to your range
if you don't want to select the range befor pinging

let me know how it turns out

thanks


IP-ping.xls
jpaulino
Can you remove the button and can i run the macro manually
Leave the Row 1 and 2 blank.
jpaulino
Can you remove the button and can i run the macro manually
Leave the Row 1 and 2 blank.

>> Can you remove the button and can i run the macro manually
>> Leave the Row 1 and 2 blank.

You can assign that macro to a toolbar menu item or you have other idea ?
What i meant is.Can we remove the button and just run the macro .
I have the machinenames  from row 3 .So can the macro run from row 3.
>> Can we remove the button and just run the macro .
You can go to Tools - Macro - Macros, select the macro you whant an run it.

If you want to do for row 3 you just have to change this in the code:
For x = 1 To Cells(65536, 17).End(xlUp).Row

To:
For x = 3 To Cells(65536, 17).End(xlUp).Row

Thanks a lot for the effort.
Excellent help...
Glad I could help and thanks for the grade.