Public Sub Test()
 Dim dm As WIA.DeviceManager
 Dim di As WIA.DeviceInfo
 Dim dp As WIA.Property
 Dim de As WIA.Device
 Dim dt As WIA.Item
 Dim dtc As Long
 Dim sv As WIA.Vector
 Dim pv
 
 Set dm = New WIA.DeviceManager

 For Each di In dm.DeviceInfos
    Debug.Print di.DeviceID, Choose(di.Type + 1, "Unspecified", "Scanner", "Camera", "Video")
    For Each dp In di.Properties
       Debug.Print Space$(3); dp.Name, dp.Value
    Next dp
    Set dp = Nothing
    
    Set de = di.Connect
    dtc = 0
    For Each dt In de.Items
       dtc = dtc + 1
       Debug.Print String$(3, "***"); "Device Item"; dtc
       
       If dt.Properties.Exists("Horizontal Resolution") Then
          Set dp = dt.Properties("Horizontal Resolution")
          If dp.SubType = ListSubType Then
             Debug.Print Space$(6); "List of possible Horizontal Resolution property values:"
             For Each pv In dp.SubTypeValues
                Debug.Print Space$(9); pv
             Next pv
          Else
             Debug.Print Space$(6); "Unexpected subtype of Horizontal Resolution property"
          End If
          Debug.Print Space$(6); "Horizontal Resolution property is "; IIf(dp.IsReadOnly, "", "not "); "read-only"
          Set dp = Nothing
       Else
          Debug.Print Space$(6); "Horizontal Resolution property not found"
       End If
       
       If dt.Properties.Exists("Vertical Resolution") Then
          Set dp = dt.Properties("Vertical Resolution")
          If dp.SubType = ListSubType Then
             Debug.Print Space$(6); "List of possible Vertical Resolution property values:"
             For Each pv In dp.SubTypeValues
                Debug.Print Space$(9); pv
             Next pv
          Else
             Debug.Print Space$(6); "Unexpected subtype of Vertical Resolution property"
          End If
          Debug.Print Space$(6); "Vertical Resolution property is "; IIf(dp.IsReadOnly, "", "not "); "read-only"
          Set dp = Nothing
       Else
          Debug.Print Space$(6); "Vertical Resolution property not found"
       End If
    
    Next dt
    Set dt = Nothing
    Set de = Nothing
 
    Debug.Print
 Next di
 Set di = Nothing
 Set dm = Nothing
End Sub