HELP - How do I determine my computers IP address through VBA in Excel

[jolipe]

How do I determine my computers IP address through VBA in Excel

Does anyone knows how can i do this??

 

[Jef Gorbach]

How do I determine my computers IP address through VBA in Excel

Does anyone knows how can i do this???

If you're using dynamic addressing then the IP# may not be helpful since
it'll change between/during sessions, however bob is working on a similar
question in the microsoft.public.scripting.vbscript formum:

Can you retrieve information like BIOS versions, serial numbers, etc? I'm
creating a web site for our techs to open a web page, on a customers
workstation, and have that data automatically populate data fields. This
info
will then go until a database tracking site.
Thanks

Bob

Here's a vbs script available from microsoft portable code
You'll have to play with it to change it from vbs to hta script.

strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colBIOS = objWMIService.ExecQuery _
("Select * from Win32_BIOS")

For each objBIOS in colBIOS
Wscript.Echo "Build Number: " & objBIOS.BuildNumber
Wscript.Echo "Current Language: " & objBIOS.CurrentLanguage
Wscript.Echo "Installable Languages: " & objBIOS.InstallableLanguages
Wscript.Echo "Manufacturer: " & objBIOS.Manufacturer
Wscript.Echo "Name: " & objBIOS.Name
Wscript.Echo "Primary BIOS: " & objBIOS.PrimaryBIOS
Wscript.Echo "Release Date: " & objBIOS.ReleaseDate
Wscript.Echo "Serial Number: " & objBIOS.SerialNumber
Wscript.Echo "SMBIOS Version: " & objBIOS.SMBIOSBIOSVersion
Wscript.Echo "SMBIOS Major Version: " & objBIOS.SMBIOSMajorVersion
Wscript.Echo "SMBIOS Minor Version: " & objBIOS.SMBIOSMinorVersion
Wscript.Echo "SMBIOS Present: " & objBIOS.SMBIOSPresent
Wscript.Echo "Status: " & objBIOS.Status
Wscript.Echo "Version: " & objBIOS.Version
For i = 0 to Ubound(objBIOS.BiosCharacteristics)
Wscript.Echo "BIOS Characteristics: " & _
objBIOS.BiosCharacteristics(i)
Next
Next

 

[RB Smissaert]

One way of doing it:

Sub test()

Dim IP_Address: IP_Address = GetIP()

If IP_Address = "0.0.0.0" Or IP_Address = "" Then
MsgBox "No IP Address found.", , ""
Else
MsgBox IP_Address, , "IP address"
End If

End Sub

Function GetIP()

Dim ws: Set ws = CreateObject("WScript.Shell")
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")

Dim TmpFile: TmpFile = fso.GetSpecialFolder(2) & "/ip.txt"
Dim ThisLine, IP

If ws.Environment("SYSTEM")("OS") = "" Then
ws.Run "winipcfg /batch " & TmpFile, 0, True
Else
ws.Run "%comspec% /c ipconfig > " & TmpFile, 0, True
End If

With fso.GetFile(TmpFile).OpenAsTextStream
Do While Not .AtEndOfStream
ThisLine = .ReadLine
If InStr(ThisLine, "Address") <> 0 Then
IP = Mid(ThisLine, InStr(ThisLine, ":") + 2)
End If
Loop
.Close
End With

'WinXP (NT? 2K?) leaves a carriage return at the end of line
If IP <> "" Then
If Asc(Right(IP, 1)) = 13 Then IP = Left(IP, Len(IP) - 1)
End If

GetIP = IP

fso.GetFile(TmpFile).Delete

Set fso = Nothing
Set ws = Nothing

End Function


RBS

 

[RB Smissaert]

Here is another one that is a bit quicker:

Private Const IP_SUCCESS As Long = 0
Private Const WS_VERSION_REQD As Long = &H101
Private Const MIN_SOCKETS_REQD As Long = 1
Private Const SOCKET_ERROR As Long = -1
Private Const INADDR_NONE As Long = &HFFFFFFFF
Private Const MAX_WSADescription As Long = 256
Private Const MAX_WSASYSStatus As Long = 128
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 Long
wMaxUDPDG As Long
dwVendorInfo As Long
End Type
Private Declare Function gethostbyname Lib "WSOCK32.DLL" _
(ByVal hostname As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(xDest As Any, _
xSource As Any, _
ByVal nbytes As Long)
Private Declare Function WSAStartup Lib "WSOCK32.DLL" _
(ByVal wVersionRequired As Long, _
lpWSADATA As WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare Function inet_addr Lib "WSOCK32.DLL" _
(ByVal s As String) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" _
(ByVal Buffer As String, _
Size As Long) As Long

Sub TestingFunction()
If SocketsInitialize() Then
MsgBox GetIPFromHostName(GetPcName), , "IP address of " & GetPcName
End If
SocketsCleanup
End Sub

Private Function GetIPFromHostName(ByVal sHostName As String) As String
'converts a host name to an IP address.
Dim nbytes As Long
Dim ptrHosent As Long 'address of hostent structure
Dim ptrName As Long 'address of name pointer
Dim ptrAddress As Long 'address of address pointer
Dim ptrIPAddress As Long
Dim sAddress As String
sAddress = Space$(4)
ptrHosent = gethostbyname(sHostName & vbNullChar)
If ptrHosent <> 0 Then
ptrName = ptrHosent
ptrAddress = ptrHosent + 12
'get the IP address
CopyMemory ptrName, ByVal ptrName, 4
CopyMemory ptrAddress, ByVal ptrAddress, 4
CopyMemory ptrIPAddress, ByVal ptrAddress, 4
CopyMemory ByVal sAddress, ByVal ptrIPAddress, 4
GetIPFromHostName = IPToText(sAddress)
End If
End Function

Private Function IPToText(ByVal IPAddress As String) As String
IPToText = CStr(Asc(IPAddress)) & "." & _
CStr(Asc(Mid$(IPAddress, 2, 1))) & "." & _
CStr(Asc(Mid$(IPAddress, 3, 1))) & "." & _
CStr(Asc(Mid$(IPAddress, 4, 1)))
End Function

Private Sub SocketsCleanup()
If WSACleanup() <> 0 Then
MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
End If
End Sub

Private Function SocketsInitialize() As Boolean
Dim WSAD As WSADATA
SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
End Function

Private Function GetPcName() As String
Dim strBuf As String * 16, strPcName As String, lngPc As Long
lngPc = GetComputerName(strBuf, Len(strBuf))
If lngPc <> 0 Then
strPcName = Left(strBuf, InStr(strBuf, vbNullChar) - 1)
GetPcName = strPcName
Else
GetPcName = vbNullString
End If
End Function


RBS