none
VBA ACCESS 2003 - Getting IP address

    Question

  • 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.

     

     

     

    Tuesday, October 09, 2007 10:39 AM

Answers

  •  

    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

    Tuesday, October 09, 2007 2:31 PM
  • 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

     

     

     

     

    Thursday, October 11, 2007 5:39 AM

All replies

  •  

    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

    Tuesday, October 09, 2007 2:31 PM
  • Thanks man, I am trying to understand it.

    Aldo.

    Wednesday, October 10, 2007 5:59 AM
  •  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.

    Wednesday, October 10, 2007 3:02 PM
  • 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

     

     

     

     

    Thursday, October 11, 2007 5:39 AM