I have two laser scanner connect to computer
Could i get the name of scanner when scanning by using VBA?
Thank you very much!
I have two laser scanner connect to computer
Could i get the name of scanner when scanning by using VBA?
Thank you very much!
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
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
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
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
---------------------------------------------------------------------------------------------------------------------
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
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
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