Coding in support of these Thread posts
http://www.excelfox.com/forum/showth...ll=1#post11569
http://www.excelfox.com/forum/showth...ll=1#post11672




Code:

Sub ipconfigall_routeprint(Optional ByVal Msg As String) '
Rem 1 ipconfig /all
 Shell "cmd.exe /c ""ipconfig /all > """ & ThisWorkbook.Path & "\ipconfig__all.txt"""""
' Get the entire text file as a string
Dim FileNum As Long: Let FileNum = FreeFile(1) '
Dim PathAndFileName As String, strIPcon As String
 Let PathAndFileName = ThisWorkbook.Path & "\ipconfig__all.txt"
 ' Let PathAndFileName = ThisWorkbook.Path & "\test2B.txt"  '  Al
  Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
    strIPcon = VBA.Strings.Space$(LOF(FileNum)) '....and wot recives it hs to be a string of exactly the right length
    Get #FileNum, , strIPcon
  Close #FileNum
' Tidy the string
 Let strIPcon = Replace(strIPcon, vbCr & vbCr, vbCr, 1, -1, vbBinaryCompare)
 Let strIPcon = Replace(strIPcon, vbTab, "   ", 1, -1, vbBinaryCompare)
' add any extra info to string
Dim PublicIP As String: Call PubicIP(PublicIP)
  Let strIPcon = "ipconfig /all   route print" & Msg & vbCr & vbLf & ComputerName & vbCr & vbLf & GetIpAddrTable & vbCr & vbLf & PublicIP & vbCr & vbLf & vbCr & vbLf & """" & Format(Now, "DD MMM YYYY") & " " & vbLf & " " & Format(Now, "hh mm ss") & """" & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & strIPcon        ' vbLf is recognised as a new line within an Excel"
' String content check
' Call WtchaGot(strIPcon)
' put the text in the clipboard
Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
objDataObject.SetText strIPcon: objDataObject.PutInClipboard

' Excel Worksheet
Dim Ws As Worksheet: Set Ws = ActiveSheet
Dim Clm As Range, NxtClm As Long
 Set Clm = Ws.Cells.Find(What:="*", After:=Ws.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
    If Clm Is Nothing Then
     Let NxtClm = 2
    Else
     Let NxtClm = Clm.Column + 1
    End If
' Put in next free column in Active sheet
 Ws.Paste Destination:=Ws.Cells.Item(1, NxtClm)
' Ws.Columns.AutoFit: Ws.Rows.AutoFit

Rem 2 route print
 Shell "cmd.exe /c ""route print > """ & ThisWorkbook.Path & "\route_print.txt"""""
' Get the entire text file as a string
 Let FileNum = FreeFile(1) '              ' The "highway/ street/ link" to be built to transport the text will be given a number. It must be unique. So we use for convenience, the Freefile function: it returns an integer that represents the next file number that the Open statement can use.  The optional argument for the range number is a variant that is used to specify a range from which the next free file number is returned. Enter a value of data type 0 (default) to return a file number in the range 1 - 255 inclusive. Enter 1 to return a file number in the range 256 - 511.   https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/freefile-function  . Note also : Use file numbers in the range 1-255, inclusive, for files not accessible to other applications. Use file numbers in the range 256-511 for files accessible from other applications
Dim strrouteprint As String
 Let PathAndFileName = ThisWorkbook.Path & "\route_print.txt"
 ' Let PathAndFileName = ThisWorkbook.Path & "\test2B.txt"  '  Al
  Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
    strrouteprint = VBA.Strings.Space$(LOF(FileNum)) '....and wot recives it hs to be a string of exactly the right length
    Get #FileNum, , strrouteprint
  Close #FileNum
' Tidy the string
 Let strrouteprint = Replace(strrouteprint, vbCr & vbCr, vbCr, 1, -1, vbBinaryCompare)
 Let strrouteprint = Replace(strrouteprint, vbTab, "   ", 1, -1, vbBinaryCompare)
' put the text in the clipboard
objDataObject.SetText strrouteprint: objDataObject.PutInClipboard
' Excel Worksheet
Dim Lr As Long: Let Lr = Ws.Cells(Ws.Rows.Count, NxtClm).End(xlUp).Row
' Put in next free column in Active sheet
 Ws.Paste Destination:=Ws.Cells.Item(Lr + 30, NxtClm)
 Ws.Columns.AutoFit: Ws.Rows.AutoFit
 ActiveWindow.Panes(2).Activate
 Ws.Cells.Item(1, NxtClm).Select
End Sub
'