'---------------------------------------------------------------------------------------
' Procedure : GetActiveAdapterDetailsOptionalOutput
' Author : ChatGPT modified: bbfromgb, InView
' Date : 23.06.2025
' Purpose : Find network adapter having internet access (No CMD Window Flash)
' Outputs Adapter Description, IPV4, IPV6, MAC, Gateway, and DNS Details (Split)
'
' Usage : Call GetActiveAdapterDetails(True, True,True) ' Choice Output to Immediate, MsgBox, and HTML (AutoOpen)
'-----------------------------------------------------------------------------------------
Public Function GetActiveAdapterDetails(Optional PrintToDebug As Boolean = True, Optional ShowMsgBox As Boolean = False, Optional ExportAsHTML As Boolean = False) As String
' Declares required object and variables
Dim shell As Object, fso As Object, tempFile As String
Dim WMI As Object, configs As Object, config As Object
Dim line As String, parts As Variant, interfaceIP As String
Dim ipCheck As Variant, ipListItem As Variant
Dim i As Integer, found As Boolean
Dim ipv4List As String, ipv6List As String, output As String
Dim htmlOutput As String, htmlPath As String, htmlFile As Object
On Error GoTo HandleError
' Create scripting and shell objects
Set shell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
' Define temp output file path
tempFile = Environ("TEMP") & "\route_output.txt"
' Run route command silently to get routing table and redirect output to temp file
shell.Run "cmd /c route print 0.0.0.0 > """ & tempFile & """", 0, True
' Exit if the route output file doesn't exist (safety check)
If Not fso.FileExists(tempFile) Then Exit Function
' Read route output file to extract interface IP for default route (0.0.0.0)
With fso.OpenTextFile(tempFile, 1)
Do While Not .AtEndOfStream
line = Trim(.ReadLine)
If InStr(line, "0.0.0.0") = 1 Then
parts = Split(line)
' Scan backwards to find something that looks like an IP address
For i = UBound(parts) To 0 Step -1
If InStr(parts(i), ".") > 0 Then
interfaceIP = parts(i)
Exit Do
End If
Next
End If
Loop
.Close
End With
' Delete temp file after reading
fso.DeleteFile tempFile
' If no IP address was found, terminate early
If Len(interfaceIP) = 0 Then Exit Function
' Use WMI to get all active (IP-enabled) network adapters
Set WMI = GetObject("winmgmts:\\.\root\CIMV2")
Set configs = WMI.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = TRUE")
' Loop through each adapter
For Each config In configs
If Not IsNull(config.IPAddress) Then
' Check if this adapter owns the interface IP from the route
For Each ipCheck In config.IPAddress
If ipCheck = interfaceIP Then
found = True
ipv4List = "": ipv6List = ""
' Split adapter's IPs into separate IPv4 and IPv6 lists
For Each ipListItem In config.IPAddress
If InStr(ipListItem, ":") > 0 Then
ipv6List = ipv6List & ipListItem & ", "
Else
ipv4List = ipv4List & ipListItem & ", "
End If
Next
' Format output as plain text
output = "Active Network Adapter Info:" & vbCrLf & vbCrLf
output = output & " Description : " & config.Description & vbCrLf
output = output & " MAC Address : " & config.MACAddress & vbCrLf
If Len(ipv4List) > 0 Then output = output & " IPv4 Address : " & Left(ipv4List, Len(ipv4List) - 2) & vbCrLf
If Len(ipv6List) > 0 Then output = output & " IPv6 Address : " & Left(ipv6List, Len(ipv6List) - 2) & vbCrLf
If Not IsNull(config.DefaultIPGateway) Then output = output & " Gateway : " & Join(config.DefaultIPGateway, ", ") & vbCrLf
' Append DNS server information
If Not IsNull(config.DNSServerSearchOrder) Then
output = output & " Primary DNS : " & config.DNSServerSearchOrder(0) & vbCrLf
If UBound(config.DNSServerSearchOrder) >= 1 Then
output = output & " Secondary DNS : " & config.DNSServerSearchOrder(1) & vbCrLf
End If
Else
output = output & " DNS Servers : (none configured)" & vbCrLf
End If
' Generate HTML version of same output, replacing line breaks
htmlOutput = "<html><head><style>" & _
"body{font-family:Segoe UI;line-height:1.4;} h2{color:#2E8B57;} " & _
"pre{background:#f0f0f0;padding:10px;}</style></head><body>"
htmlOutput = htmlOutput & "<h2>Active Network Adapter Info</h2><pre>" & Replace(output, vbCrLf, vbLf) & "</pre></body></html>"
htmlPath = Environ("TEMP") & "\ActiveNetworkAdapter.html"
' If ExportAsHTML is enabled, write to .html file and open in browser
If ExportAsHTML Then
Set htmlFile = fso.CreateTextFile(htmlPath, True)
htmlFile.Write htmlOutput
htmlFile.Close
shell.Run """" & htmlPath & """", 1, False
End If
Exit For ' Exit IP loop
End If
Next
End If
If found Then Exit For ' Exit adapter loop once a match is found
Next
' Optional output methods
If PrintToDebug And Len(output) > 0 Then Debug.Print output
If ShowMsgBox And Len(output) > 0 Then MsgBox output, vbInformation, "Active Network Adapter"
GetActiveAdapterDetails = output
Exit Function
HandleError:
' Display error message if anything fails during execution
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in GetActiveAdapterDetails", vbCritical
End Function
