Consulting

Results 1 to 7 of 7

Thread: How to get the name of USB port name

  1. #1
    VBAX Contributor
    Joined
    Nov 2009
    Posts
    114
    Location

    How to get the name of USB port name

    I have two laser scanner connect to computer
    Could i get the name of scanner when scanning by using VBA?

    Thank you very much!

  2. #2
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    Add the reference, run, and check the Immediate Window for results.
    'Add reference: Microsoft Scripting Runtime
    Sub DrivesInfo()
        Dim fso As FileSystemObject, aDrive As Drive
    
    
        Set fso = New FileSystemObject
        'Set aDrive = fso.GetDrive("C:\")
        
        On Error Resume Next
        For Each aDrive In fso.Drives
          With aDrive
            Debug.Print "Drive Type: " & .DriveType
            Debug.Print "Drive Letter: " & .DriveLetter
            Debug.Print "Share Name" & .ShareName
            Debug.Print "Volume Name: " & .VolumeName
            Debug.Print "Free Space: " & Format(.FreeSpace / 1000000000#, "#0.00") & "GB"
            Debug.Print "Total Size: " & Format(.TotalSize / 1000000000#, "#0.00") & "GB"
            Debug.Print "Ready: " & .IsReady
            Debug.Print vbCrLf
          End With
        Next aDrive
        
        Set fso = Nothing
        Set aDrive = Nothing
    End Sub

  3. #3
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Ken -- does that return the scanner name?
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  4. #4
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    I doubt it. The OP asked for USB data which is a drive.

    What the OP probably needs is printer name and port information. That requires another method. e.g. http://www.cpearson.com/excel/GetPrinters.aspx

  5. #5
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Not my work, but I extracted enough to return the scanner's name (based on the service being 'usbscan') into a function called 'FindScanner'

    I only have one scanner so once it's found, I exit,

    You could change it to return a list of scanners


    Option Explicit
    
    Sub drv()
    MsgBox FindScanner
    End Sub
        
    Function FindScanner() As String
        'Declaring the necessary variables.
        Dim strComputer     As String
        Dim strDeviceName   As String
        Dim objWMIService   As Object
        Dim colControllers  As Object
        Dim objController   As Object
        Dim colUSBDevices   As Object
        Dim objUSBDevice    As Object
        Dim i               As Integer
        
        'Just in case of an error...
        On Error Resume Next
        
        'Disable screen flickering.
        Application.ScreenUpdating = False
        
        'Set the computer.
        strComputer = "."
        
        'The root\cimv2 namespace is used to access the Win32_USBControllerDevice class.
        Set objWMIService = GetObject("winmgmts:\\" & "." & "\root\cimv2")
        
        'A select query is used to get the list of all USB controllers.
        Set colControllers = objWMIService.ExecQuery("Select * From Win32_USBControllerDevice")
        
        'Start below sheet headings.
        i = 2
        
        'Loop through all the collection of USB controllers.
        For Each objController In colControllers
           
           'Retrieve the device name from the controller.
           strDeviceName = Replace(objController.Dependent, Chr(34), "")
           strDeviceName = Right(strDeviceName, Len(strDeviceName) - WorksheetFunction.Find("=", strDeviceName))
           
           'Execute a select query on Win32_PnPEntity class based on device name.
           Set colUSBDevices = objWMIService.ExecQuery("Select * From Win32_PnPEntity Where DeviceID = '" & strDeviceName & "'")
           
           'Loop through all the USB devices and write the necessary data in the sheet.
           For Each objUSBDevice In colUSBDevices
                If objUSBDevice.Service = "usbscan" Then
                    FindScanner = objUSBDevice.Name
                    Exit Function
                End If
                i = i + 1
            Next
        Next
    End Function
    
    Sub RetrieveUSBInfo()
        '--------------------------------------------------------------------------------------------------
        'Loops through all the USB controllers and devices (sticks, hubs, etc.) and retrieves information.
        'The code uses a WMI script in order to access the Win32_USBControllerDevice class.
               
        'Written by:    Christos Samaras
        'Date:          13/01/2014
        'e-mail:        xristos.samaras@gmail.com
        'site:          http://www.myengineeringworld.net
        '--------------------------------------------------------------------------------------------------
       
        'Declaring the necessary variables.
        Dim strComputer     As String
        Dim strDeviceName   As String
        Dim objWMIService   As Object
        Dim colControllers  As Object
        Dim objController   As Object
        Dim colUSBDevices   As Object
        Dim objUSBDevice    As Object
        Dim i               As Integer
        Dim shUSB As Worksheet
        
        
        Set shUSB = Worksheets("USB")
        
        'Just in case of an error...
        On Error Resume Next
        
        'Disable screen flickering.
        Application.ScreenUpdating = False
        
        'Clear the sheet (except headings).
        shUSB.Range("A2:E1048576").ClearContents
        
        'Set the computer.
        strComputer = "."
        
        'The root\cimv2 namespace is used to access the Win32_USBControllerDevice class.
        Set objWMIService = GetObject("winmgmts:\\" & "." & "\root\cimv2")
        
        'A select query is used to get the list of all USB controllers.
        Set colControllers = objWMIService.ExecQuery("Select * From Win32_USBControllerDevice")
        
        'Start below sheet headings.
        i = 2
        
        'Loop through all the collection of USB controllers.
        For Each objController In colControllers
           
           'Retrieve the device name from the controller.
           strDeviceName = Replace(objController.Dependent, Chr(34), "")
           strDeviceName = Right(strDeviceName, Len(strDeviceName) - WorksheetFunction.Find("=", strDeviceName))
           
           'Execute a select query on Win32_PnPEntity class based on device name.
           Set colUSBDevices = objWMIService.ExecQuery("Select * From Win32_PnPEntity Where DeviceID = '" & strDeviceName & "'")
           
           'Loop through all the USB devices and write the necessary data in the sheet.
           For Each objUSBDevice In colUSBDevices
                With shUSB
                    .Cells(i, 1).Value = objUSBDevice.Name
                    .Cells(i, 2).Value = objUSBDevice.Manufacturer
                    .Cells(i, 3).Value = objUSBDevice.Status
                    .Cells(i, 4).Value = objUSBDevice.Service
                    .Cells(i, 5).Value = objUSBDevice.DeviceID
                End With
                i = i + 1
            Next
        Next
        
        'Adjust columns width.
        shUSB.Columns("A:E").AutoFit
        
        'Inform the user about the process.
        MsgBox "Information from " & i - 2 & " USB devices was retrieved successfully!", vbInformation, "Finished"
        
    End Sub
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  6. #6
    VBAX Newbie
    Joined
    Feb 2017
    Posts
    3
    Location
    Hello,
    Is it possible by adapting your code (I am not enough VBA specialist)
    To do this:
    Use several keyboards on a single PC and inform different cells?
    Example:
    Keyboard 1 (port usb1; hub1 => Cell A1 in sheet1
    Keyboard 2 (port usb2, hub1 => Cell B1 in sheet1
    Etc.

    (Win10 / 64bits & Excel 2010 32bits, VBA 7.0)
    Thank you for your help

  7. #7
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    Ken,

    I had to rearrange your code e'er so slightly to make it run without errors
    
     'Add reference: Microsoft Scripting Runtime
     'See output in Immediate Window
     
     Sub DrivesInfo()
        Dim fso As FileSystemObject, aDrive As Drive
         
         
        Set fso = New FileSystemObject
         'Set aDrive = fso.GetDrive("C:\")
         
        On Error Resume Next
        Application.DisplayAlerts = False
        For Each aDrive In fso.Drives
            With aDrive
                Debug.Print "Drive Type: " & .DriveType
                Debug.Print "Drive Letter: " & .DriveLetter
                Debug.Print "Share Name" & .ShareName
                Debug.Print "Ready: " & .IsReady
                If Not .IsReady Then GoTo nextdrive
    
                Debug.Print "Volume Name: " & .VolumeName
                Debug.Print "Free Space: " & Format(.FreeSpace / 1000000000#, "#0.00") & "GB"
                Debug.Print "Total Size: " & Format(.TotalSize / 1000000000#, "#0.00") & "GB"
            End With
    nextdrive:
            Debug.Print vbCrLf
        Next aDrive
        Set fso = Nothing
        Set aDrive = Nothing
    End Sub
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •