Sub Demo_GetServicePackWMI()
  Dim objWMI As Object
  Dim colItems As Object
  Dim objItem As Object

  On Error Resume Next

  Set objWMI = GetObject("WinMgmts:")
  If Err.Number <> 0 Then
    MsgBox "Kein WMI installiert!"

    Err.Clear
    Set objWMI = Nothing
    Exit Sub
  End If

  Set objWMI = GetObject("WinMgmts:/root/cimv2")
  Set colItems = objWMI.ExecQuery( _
          "SELECT * FROM Win32_OperatingSystem")

  For Each objItem In colItems
    If objItem.OSType = 18 Then
      MsgBox objItem.Caption & vbNewLine & _
              objItem.CSDVersion
    Else
      MsgBox "Der Service-Pack kann nur für die " & _
              "Betriebssysteme 'Windows NT, 2000 und XP' " & _
              "ermittelt werden."
    End If
  Next objItem

  Set objItem = Nothing
  Set colItems = Nothing
  Set objWMI = Nothing
End Sub