Lấy Danh Sách Máy In (1 người xem)
- Thread starter namhn_vn
- Ngày gửi
Người dùng đang xem chủ đề này
giaiphap
==(^o^)==
- Tham gia
- 12/3/07
- Bài viết
- 5,808
- Được thích
- 6,367
- Donate (Momo)
- Giới tính
- Nam
PacificPR
Thành viên mới
- Tham gia
- 6/5/16
- Bài viết
- 1,997
- Được thích
- 2,747
Bạn thử Code này thử xem. Cái này mình "Chôm" được của 1 anh rất nổi tiếng trên GPE
HTML:
Sub List_Printer()
Dim aPrinters As Object
Dim arr(), j As Long
Dim i As Long, n As Long, Str As String
With CreateObject("WScript.Network")
Set aPrinters = .EnumPrinterConnections
For i = 1 To aPrinters.Count Step 2
j = j + 1
ReDim Preserve arr(1 To j)
arr(j) = aPrinters.Item(i)
Next
Str = Join(arr, Chr(10))
End With
MsgBox Str
End Sub
- Tham gia
- 18/3/08
- Bài viết
- 8,311
- Được thích
- 15,873
- Giới tính
- Nam
- Nghề nghiệp
- Làm ruộng.
E muốn lấy list danh sách máy in kiểu như thế này được không A? "Samsung Network PC Fax on Ne02:"
quanluu
Thành viên gắn bó
- Tham gia
- 11/4/13
- Bài viết
- 2,157
- Được thích
- 1,274
- Donate (Momo)
- Giới tính
- Nam
Bạn chạy sub test
Mã:
Option Explicit
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKCU = HKEY_CURRENT_USER
Private Const KEY_QUERY_VALUE = &H1&
Private Const ERROR_NO_MORE_ITEMS = 259&
Private Const ERROR_MORE_DATA = 234
Private Declare Function RegOpenKeyEx Lib "advapi32" _
Alias "RegOpenKeyExA" ( _
ByVal HKey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
phkResult As Long) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" _
Alias "RegEnumValueA" ( _
ByVal HKey As Long, _
ByVal dwIndex As Long, _
ByVal lpValueName As String, _
lpcbValueName As Long, _
ByVal lpReserved As Long, _
lpType As Long, _
lpData As Byte, _
lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
ByVal HKey As Long) As Long
Public Function GetPrinterFullNames() As String()
Dim Printers() As String ' array of names to be returned
Dim PNdx As Long ' index into Printers()
Dim HKey As Long ' registry key handle
Dim Res As Long ' result of API calls
Dim Ndx As Long ' index for RegEnumValue
Dim ValueName As String ' name of each value in the printer key
Dim ValueNameLen As Long ' length of ValueName
Dim DataType As Long ' registry value data type
Dim ValueValue() As Byte ' byte array of registry value value
Dim ValueValueS As String ' ValueValue converted to String
Dim CommaPos As Long ' position of comma character in ValueValue
Dim ColonPos As Long ' position of colon character in ValueValue
Dim M As Long ' string index
' registry key in HCKU listing printers
Const PRINTER_KEY = "Software\Microsoft\Windows NT\CurrentVersion\Devices"
PNdx = 0
Ndx = 0
' assume printer name is less than 256 characters
ValueName = String$(256, Chr(0))
ValueNameLen = 255
' assume the port name is less than 1000 characters
ReDim ValueValue(0 To 999)
' assume there are less than 1000 printers installed
ReDim Printers(1 To 1000)
' open the key whose values enumerate installed printers
Res = RegOpenKeyEx(HKCU, PRINTER_KEY, 0&, _
KEY_QUERY_VALUE, HKey)
' start enumeration loop of printers
Res = RegEnumValue(HKey, Ndx, ValueName, _
ValueNameLen, 0&, DataType, ValueValue(0), 1000)
' loop until all values have been enumerated
Do Until Res = ERROR_NO_MORE_ITEMS
M = InStr(1, ValueName, Chr(0))
If M > 1 Then
' clean up the ValueName
ValueName = Left(ValueName, M - 1)
End If
' find position of a comma and colon in the port name
CommaPos = InStr(1, ValueValue, ",")
ColonPos = InStr(1, ValueValue, ":")
' ValueValue byte array to ValueValueS string
On Error Resume Next
ValueValueS = Mid(ValueValue, CommaPos + 1, ColonPos - CommaPos)
On Error GoTo 0
' next slot in Printers
PNdx = PNdx + 1
Printers(PNdx) = ValueName & " on " & ValueValueS
' reset some variables
ValueName = String(255, Chr(0))
ValueNameLen = 255
ReDim ValueValue(0 To 999)
ValueValueS = vbNullString
' tell RegEnumValue to get the next registry value
Ndx = Ndx + 1
' get the next printer
Res = RegEnumValue(HKey, Ndx, ValueName, ValueNameLen, _
0&, DataType, ValueValue(0), 1000)
' test for error
If (Res <> 0) And (Res <> ERROR_MORE_DATA) Then
Exit Do
End If
Loop
' shrink Printers down to used size
ReDim Preserve Printers(1 To PNdx)
Res = RegCloseKey(HKey)
' Return the result array
GetPrinterFullNames = Printers
End Function
Sub Test()
Dim Printers() As String
Dim N As Long
Dim S As String
Printers = GetPrinterFullNames()
For N = LBound(Printers) To UBound(Printers)
S = S & Printers(N) & vbNewLine
Next N
MsgBox S, vbOKOnly, "Printers"
Debug.Print S
End Subcảm ơn bạn nhiều. cái này đúng ý mình rồi
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,963
Code ngắn gọn đây:
Tặng luôn cái form lấy danh sách máy in + set active printer luôn
Mã:
Public Const HKEY_CURRENT_USER As Long = &H80000001
Public Const WMI_CLASS As String = "winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv"
Public Const HKEY_DEVICES As String = "Software\Microsoft\Windows NT\CurrentVersion\Devices"
Function GetAllPrinters()
Dim sPrinter As String
Dim regValue As String
Dim idx As Long
Dim arrPrinters() As Variant
On Error Resume Next
With CreateObject(WMI_CLASS)
.EnumValues HKEY_CURRENT_USER, HKEY_DEVICES, arrPrinters
For idx = LBound(arrPrinters) To UBound(arrPrinters)
.GetStringValue HKEY_CURRENT_USER, HKEY_DEVICES, arrPrinters(idx), regValue
sPrinter = arrPrinters(idx) & " on " & Split(regValue, ",")(1)
arrPrinters(idx) = sPrinter
Next
End With
GetAllPrinters = arrPrinters
End Functioncảm ơn anh
Bài viết mới nhất
- Question
