ajliaks


Hi guys,

This is my very first time trying to use VBA in access, so...

Let's say that I have a table named "myTable", which contains a field named "myField".

I need to insert The IP address of the working station that is using the application into myTable.myField.

Thanks in advance for any help. (Please be as clear as you can).

Aldo.





Re: VBA ACCESS 2003 - Getting IP address

nullGumby


1) From Access go to the Tools menu, Macros, Visual Basic Editor

2) In Visual Basic Editor go to Insert, Module

3) In this new module past the following code:

Code Block

Private Declare Function GetIpAddrTable_API Lib "IpHlpApi" Alias "GetIpAddrTable" (pIPAddrTable As Any, pdwSize As Long, ByVal bOrder As Long) As Long

' Returns an array with the local IP addresses (as strings).
' Author: Christian d'Heureuse, www.source-code.biz
Public Function GetIpAddrTable()
Dim Buf(0 To 511) As Byte
Dim BufSize As Long: BufSize = UBound(Buf) + 1
Dim rc As Long

rc = GetIpAddrTable_API(Buf(0), BufSize, 1)

If rc <> 0 Then Err.Raise vbObjectError, , "GetIpAddrTable failed with return value " & rc

Dim NrOfEntries As Integer: NrOfEntries = Buf(1) * 256 + Buf(0)

If NrOfEntries = 0 Then GetIpAddrTable = Array(): Exit Function

ReDim IpAddrs(0 To NrOfEntries - 1) As String

Dim i As Integer

For i = 0 To NrOfEntries - 1
Dim j As Integer, s As String: s = ""
For j = 0 To 3: s = s & IIf(j > 0, ".", "") & Buf(4 + i * 24 + j): Next
IpAddrs(i) = s
Next

GetIpAddrTable = IpAddrs
End Function

' Test program for GetIpAddrTable.
Public Sub Test()
Dim IpAddrs

IpAddrs = GetIpAddrTable

Debug.Print "Nr of IP addresses: " & UBound(IpAddrs) - LBound(IpAddrs) + 1

Dim i As Integer

For i = LBound(IpAddrs) To UBound(IpAddrs)
Debug.Print IpAddrs(i)
Next
End Sub

*NOTE: I got this from http://www.source-code.biz/snippets/vbasic/8.htm






Re: VBA ACCESS 2003 - Getting IP address

ajliaks

Thanks man, I am trying to understand it.

Aldo.







Re: VBA ACCESS 2003 - Getting IP address

nullGumby

ajliaks wrote:

Thanks man, I am trying to understand it.

Aldo.

Smile Did you follow There's a line in the Public Sub Test() "Debug.Print IpAddrs(i)" where "IpAddrs(i)" will be the IP address. When I ran it on my computer, it found 4 IP address. I don't know what they all were (maybe loopbacks or something )--but the 4th one for me seemed to be the IP address I was looking for.

So you could do "IpAddrs(UBound(IpAddrs))" to get that IP address.





Re: VBA ACCESS 2003 - Getting IP address

ajliaks

Hi,

I found this one, and it gives me exacly what I need. Take a look below:

Aldo.

Code Block

Option Explicit

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 "IP address of " & GetPcName & " is: " & GetIPFromHostName(GetPcName)
End If
SocketsCleanup
End Sub

Public 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


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


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


Public 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