Option Explicit

On Error Resume Next

'Define Variables
Dim WSH, FSO, RunIPConfig, TempDir, OSName, CMD, OpenFile, AllText, IntStr1, IntCounter
Dim FileExist, IPText, IntStr2, IPStart, IPEnd, IPDiff, IPAddress, StartPos, IntStr3, IPAddress1
Dim ReplaceText, FinalIP

Set WSH = WSCript.CreateObject("WSCript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")

OSName = WSH.ExpandEnvironmentStrings("%OS%")
TempDir = WSH.ExpandEnvironmentStrings("%TEMP%")
CMD = WSH.ExpandEnvironmentStrings("%Comspec% /C")

StartPos = 1

RunIPConfig = WSH.run(CMD & " Ipconfig > %TEMP%\000001.tmp", 0, True)
WSCript.Sleep 200

FileExist = FSO.FileExists(TempDir & "\000001.tmp")

StartPos = 1

For IntCounter = 1 to 6
If FileExist = True Then
Set OpenFile = FSO.OpenTextFile(TempDir & "\000001.tmp", 1, False, 0)
OpenFile.Skip(StartPos)
Do While NOT OPenFile.AtEndOfStream
AllText = OpenFile.ReadAll
Loop
IntStr1 = Instr(StartPos, AllText, "IP Address", 1)
IntStr2 = InStr(IntStr1, AllText, ": ", 1)
IPStart = IntStr2 + 2
IPEnd = IPStart + 15
IPDiff = IPEnd - IPStart
IPAddress = Mid(AllText, IPStart, IPDiff)
IntStr3 = InStr(1, IPAddress, "0.0.0.0", 1)
If IntStr3 = "1" Then
StartPos = IPEnd
End If
If NOT IntStr3 = "1" Then
IntCounter = 6
End If
End If
Next

IPAddress1 = trim(IPAddress)

ReplaceText = Replace(IPAddress1, vbCr, "")

FinalIP = ReplaceText

MsgBox FinalIP

On Error Goto 0

WScript.Quit