Windowsサービスの情報を取得する。

WMI(Windows Management Instrumentation)を利用してWindowsサービスの情報を取得します。
VBAでWMIから情報を取得するにはSWbemLocatorオブジェクトのConnectServerメソッドを利用してコンピューター上の WMIへ接続することで取得できます。
Windowsサービスの情報は接続したWMIの Win32_Serviceクラスから取得します。

サンプルコードでは停止しているWindowsサービスの情報も取得しています。
実行中のWindowsサービスの情報だけが欲しい場合は、 ExecQueryメソッドで指定しているSQLのWhere句に「where State = ‘Running’」を付けて条件を絞ってください。
　※サンプルコードではコメントアウトした状態で記載しています。

'*****************************************************************
'　Windowsサービス情報の取得
'*****************************************************************
Sub getServiceInfo()


    '出力用シートの追加
    Dim sShtNm As String: sShtNm = "ServiceList"
    Call addSheet(sShtNm)
    
    
    'SWbemLocatorオブジェクトを作成してWMIに接続
    Dim oWMI As Object
    Set oWMI = CreateObject("WbemScripting.SWbemLocator").ConnectServer
    
    'オブジェクト取得のクエリを実行
    Dim oQrySet As Object
    Set oQrySet = oWMI.ExecQuery("SELECT * FROM Win32_Service")
    
    '実行中のサービス情報だけを出力する場合は下記のクエリを指定
    'Set oQrySet = oWMI.ExecQuery("SELECT * FROM Win32_Service where State = 'Running'")
    
    'サービスの一覧を作成
    With Sheets(sShtNm)
        .Cells(1, 1) = "サービス名"
        .Cells(1, 2) = "説明"
        .Cells(1, 3) = "プロセスID"
        .Cells(1, 4) = "種類"
        .Cells(1, 5) = "開始状況"
        .Cells(1, 6) = "サービス状態"
        .Cells(1, 7) = "オブジェクト状態"
        .Cells(1, 8) = "開始モード"
        .Cells(1, 9) = "サービス実行アカウント"
        .Cells(1, 10) = "サービスバイナリファイルへのパス"
    
    
        Dim oSRVC As Object
        Dim i As Long
        i = 2
        For Each oSRVC In oQrySet
            .Cells(i, 1) = oSRVC.DisplayName
            .Cells(i, 2) = oSRVC.Description
            .Cells(i, 3) = oSRVC.ProcessId
            .Cells(i, 4) = oSRVC.ServiceType
            .Cells(i, 5) = oSRVC.Started
            .Cells(i, 6) = oSRVC.State
            .Cells(i, 7) = oSRVC.Status
            .Cells(i, 8) = oSRVC.StartMode
            .Cells(i, 9) = oSRVC.StartName
            .Cells(i, 10) = oSRVC.PathName
            
            i = i + 1
        Next
        End With
    
    Set oQrySet = Nothing

End Sub

'******************************************************************
'　シートの追加
'------------------------------------------------------------------
'　　第１引数：設定したいシート名
'******************************************************************
Sub addSheet(getShtNm As String)
    
    '右端にシートを追加する
    Worksheets.Add After:=Sheets(Sheets.Count)
    
    'シートの名前を設定
    On Error Resume Next
    Do While True
        ActiveSheet.Name = getShtNm
        If Err.Number = 0 Then
            Exit Do
        Else
            'シート名が重複する場合は末尾に日時を付けて対応
            getShtNm = getShtNm & "_" & Format(Now(), "yyyymmddhhmmss")
            Err.Clear
        End If
    Loop
    On Error GoTo 0

End Sub

■実行結果