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:
C:\Users\User1>netstat -n | find “:3389” | find “ESTABLISHED”

Run a DOS command in VBA and capture the output:

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


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

    ShellRun = s

End Function

%d bloggers like this: