Scenario: MS Access running in a RemoteApp session needs to respond differently for a client based on their location, which is determined by their local IP address.

Techniques and References:

Run Netstat to find the IP:
https://social.technet.microsoft.com/Forums/en-US/5e688558-7925-40e5-9b24-d011b14a1163/how-to-retreive-the-ip-address-of-a-terminal-server-connected-user?forum=ITCG
C:\Users\User1>netstat -n | find “:3389” | find “ESTABLISHED”

Run a DOS command in VBA and capture the output:
https://stackoverflow.com/a/32600510/7466341

Using the above code, we get pretty close, with a block like this being returned to access:

  TCP    10.10.10.83:3389       10.10.10.52:52195      ESTABLISHED
  TCP    10.10.10.83:3389       10.10.10.52:52246      ESTABLISHED
  TCP    10.10.10.83:3389       10.10.10.52:52261      ESTABLISHED
  TCP    10.10.10.83:3389       10.10.10.52:56155      ESTABLISHED
  TCP    10.10.10.83:3389       10.10.10.52:58029      ESTABLISHED
  TCP    10.10.10.83:3389       10.10.10.52:61477      ESTABLISHED
  TCP    10.10.10.83:3389       10.10.10.52:61649      ESTABLISHED

Now that we have that info, all that’s left is to slice it and dice it until we can return just the IP from a function call.

To do that, after capturing the output to a string, we split that string into lines, then split the first line into a column. Then we find the correct column – in this case, it’s column “6” because of the extra spaces in the output – and then we still need to take that value and split it on the colon, taking only the first portion.

The finished bits of code look like this:

Public Function getRemoteIP() As String
    Dim s As String
    Dim lines() As String, cols() As String, ip() As String
    
    s = ShellRun("cmd.exe /c netstat -n | find "":3389"" | find ""ESTABLISHED""")
    
    lines = Split(s, vbCrLf)
    cols = Split(lines(1), " ")
    ip = Split(cols(6), ":")
    
    getRemoteIP = ip(0)
End Function

' ----------------------------------------------------------------
' Procedure Name: ShellRun
' Purpose: Run a DOS command and capture the output
' Author: Jon
' Date: 5/14/2020
' ----------------------------------------------------------------
Public Function ShellRun(sCmd As String) As String

    'Run a shell command, returning the output as a string

    Dim oShell As Object
    Set oShell = CreateObject("WScript.Shell")

    'run command
    Dim oExec As Object
    Dim oOutput As Object
    Set oExec = oShell.Exec(sCmd)
    Set oOutput = oExec.StdOut

    'handle the results as they are written to and read from the StdOut object
    Dim s As String
    Dim sLine As String
    While Not oOutput.AtEndOfStream
        sLine = oOutput.ReadLine
        If sLine <> "" Then s = s & sLine & vbCrLf
    Wend

    ShellRun = s

End Function

%d bloggers like this: