In support of these forum posts
https://excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page51#post12776
https://excelfox.com/forum/showthrea...5356#post15356
https://eileenslounge.com/viewtopic.php?f=18&t=37740
https://eileenslounge.com/viewtopic.php?f=18&t=37712
https://eileenslounge.com/viewtopic.php?f=18&t=37707


Code:
'Version : 5.1.19041.1320
'InstanceId : e165cf30-9ddd-49ed-96c7-59cca98516ee
'UI:  System.Management.Automation.Internal.Host.InternalHostUserInterface
'CurrentCulture:  DE -DE
'CurrentUICulture:  DE -DE
'PrivateData:  Microsoft.PowerShell.Host.ISE.ISEOptions
'DebuggerEnabled : True
'IsRunspacePushed : False
'Runspace:  System.Management.Automation.Runspaces.LocalRunspace
'https://excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page51#post12776
'https://excelfox.com/forum/showthread.php/2559-Notes-tests-text-files-manipulation-of-text-files-in-Excel-and-with-Excel-VBA?p=15356#post15356
'https://eileenslounge.com/viewtopic.php?f=18&t=37740
'https://eileenslounge.com/viewtopic.php?f=18&t=37712
'https://eileenslounge.com/viewtopic.php?f=18&t=37707
Sub Services()  '  https://excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page51#post12776   https://excelfox.com/forum/showthread.php/2559-Notes-tests-text-files-manipulation-of-text-files-in-Excel-and-with-Excel-VBA?p=15356#post15356
' PowerShell
Dim PScmdLet As String, cmdLet As String
 'Let cmdLet = "Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath 'C:\Users\acer\Desktop\test.txt' -Width 1000"
 Let cmdLet = "Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath '" & ThisWorkbook.Path & Application.PathSeparator & "test.txt' -Width 1000"
 Let PScmdLet = "powershell -command " & cmdLet  '   https://www.devhut.net/vba-run-powershell-command/
 CreateObject("WScript.Shell").Exec (PScmdLet)
' Get the text file as a long single string
Dim FileNum As Long: Let FileNum = FreeFile(1)                                    ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String
 Let PathAndFileName = ThisWorkbook.Path & Application.PathSeparator & "test.txt"   '                                                               CHANGE TO SUIT                                                                                                         From vixer zyxw1234  : http://www.eileenslounge.com/viewtopic.php?f=30&t=34629     DF.txt https://app.box.com/s/gw941dh9v8sqhvzin3lo9rfc67fjsbic
Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundamental type data input...
 Let TotalFile = Space(LOF(FileNum)) '....and wot receives it has to be a string of exactly the right length
Get #FileNum, , TotalFile                                               'Debug.Print TotalFile
 Let TotalFile = Replace(TotalFile, Chr(0), "", 1, -1, vbBinaryCompare) ' There seems to be a lot of  Chr(0)s  in the string https://i.postimg.cc/t43HCQr9/Rather-a-lot-of-Chr-0-s.jpg
 'Let TotalFile = Replace(TotalFile, Chr(255) & Chr(254) & vbCr & vbLf, "", 1, 1, vbBinaryCompare) ' this would tsake the first bit of crap out, (alternatively we can just take out the first line when split later by
Close #FileNum
' Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(TotalFile)

' make a 1 D array of the text file lines
Dim arrRws() As String: Let arrRws() = Split(TotalFile, vbCr & vbLf, -1, vbBinaryCompare)

' make array for output
Dim arrOut() As String: ReDim arrOut(1 To UBound(arrRws()) - 2, 1 To 3) ' we are ignoring the first 3 lines. The  UBound  of the 1 dimensional array is already 1 less then the lines we need because a 1 dimensional array starts at 0
Dim Cnt As Long
    For Cnt = 1 To UBound(arrRws()) - 2
        If arrRws(Cnt + 2) = "" Then
        ' This should occur at the last empty rows, so we could consider jumping out of the loop here
        Else
        ' time to split the line string
        Dim Pos1 As Long: Let Pos1 = InStr(1, arrRws(Cnt + 2), "  ", vbBinaryCompare)
        Dim Nme As String: Let Nme = Left(arrRws(Cnt + 2), Pos1 - 1)
        Dim Pos3 As Long: Let Pos3 = Len(arrRws(Cnt + 2)) - InStrRev(arrRws(Cnt + 2), "  ", -1, vbBinaryCompare)
        Dim StrtTyp As String: Let StrtTyp = Right(arrRws(Cnt + 2), Pos3)
        Dim DispNme As String: Let DispNme = Replace(arrRws(Cnt + 2), Nme, "", 1, -1, vbBinaryCompare)
         Let DispNme = Replace(DispNme, StrtTyp, "", 1, -1, vbBinaryCompare)
         Let DispNme = Trim(DispNme)
        ' fill the array for output
         Let arrOut(Cnt, 1) = Nme: arrOut(Cnt, 2) = DispNme: arrOut(Cnt, 3) = StrtTyp
        End If

    Next Cnt

' Chuck array into a spreadsheet
 Let ThisWorkbook.Worksheets("PowerShell").Range("A2").Resize(UBound(arrOut(), 1), 3).Value = arrOut()
 ThisWorkbook.Worksheets("PowerShell").Cells.Columns("A:C").EntireColumn.AutoFit

End Sub

Edit Some issues…
I messed up with a few things.
_ the display name could be long and go up to the startuptype in the text file, which messed up the manipulation of a line of data from the text file a bit. For now I fiddled that by adding some spaces before the words used for the startuptype. A better solution will probably wait until I fully understand the PowerShell code line
_ There seems to be some strange effects with something somewhere working too slow, too fast or not giving accurate information about if a text file is present. For now that is fiddled with some Waits , Dirs and a Kill. That will do for now, but that need to be looked at again when I understand better wots going on

The next code version is in the next post
https://excelfox.com/forum/showthrea...ll=1#post16369