[RESOLVED] PrintDlgEx API failed to return full name of printer

I used Krool's OpenPrinterEx function in CommonDialog class. The function failed to return the full name of the chosen printer. The printer name is "\\192.4.4.143\Canon iR2002/2202 UFRII LT(1)" showing on the Printer Dialog. But I watched the return printer name (NewPrinterName) is "\\192.4.4.143\Canon iR2002/220" which is 30 characters length. what is the reason?

Quote:

---

When a Microsoft Windows application prints, it must identify the target printer by its full name. The DEVMODE structure that was introduced in 16-bit Windows version 3.1 has a limitation of 32 characters for a printer name. However, printer names in Win32 operating systems can be much longer.

---

Look like the string is being truncated. I tried to changed CCHDEVICENAME =32 to 128 to increase the buffer but still no luck. Maybe the DMDeviceName in DEVMODE structure should be defined to Pointer?

Code:

---

Private Type PRINTDLGEX
    lStructSize As Long
    hWndOwner As Long
    hDevMode As Long
    hDevNames As Long
    hDC As Long
    Flags As Long
    Flags2 As Long
    ExclusionFlags As Long
    nPageRanges As Long
    nMaxPageRanges As Long
    lpPageRanges As Long
    nMinPage As Long
    nMaxPage As Long
    nCopies As Long
    hInstance As Long
    lpPrintTemplateName As Long
    lpCallback As Long
    nPropertyPages As Long
    lphPropertyPages As Long
    nStartPage As Long
    dwResultAction As Long
End Type

Private Const CCHDEVNAMESEXTRA As Long = 100
Private Type DEVNAMES
    wDriverOffset As Integer
    wDeviceOffset As Integer
    wOutputOffset As Integer
    wDefault As Integer
    wExtra(0 To ((CCHDEVNAMESEXTRA * 2) - 1)) As Byte
End Type
Private Const CCHDEVICENAME As Long = 128 '32
Private Const CCHFORMNAME As Long = 32
Private Const DM_ORIENTATION As Long = &H1
Private Const DM_PAPERSIZE As Long = &H2
Private Const DM_COPIES As Long = &H100
Private Const DM_DEFAULTSOURCE As Long = &H200
Private Const DM_PRINTQUALITY As Long = &H400
Private Const DM_COLOR As Long = &H800
Private Const DM_DUPLEX As Long = &H1000
Private Const DM_COLLATE As Long = &H8000&
Private Type DEVMODE
    DMDeviceName(0 To ((CCHDEVICENAME * 2) - 1)) As Byte
    DMSpecVersion As Integer
    DMDriverVersion As Integer
    DMSize As Integer
    DMDriverExtra As Integer
    DMFields As Long
    DMOrientation As Integer
    DMPaperSize As Integer
    DMPaperLength As Integer
    DMPaperWidth As Integer
    DMScale As Integer
    DMCopies As Integer
    DMDefaultSource As Integer
    DMPrintQuality As Integer
    DMColor As Integer
    DMDuplex As Integer
    DMYResolution As Integer
    DMTTOption As Integer
    DMCollate As Integer
    DMFormName(0 To ((CCHFORMNAME * 2) - 1)) As Byte
    DMLogPixels As Integer
    DMBitsPerPel As Long
    DMPelsWidth As Long
    DMPelsHeight As Long
    DMDisplayFlags As Long
    DMDisplayFrequency As Long
    DMICMMethod As Long
    DMICMIntent As Long
    DMMediaType As Long
    DMDitherType As Long
    DMReserved1 As Long
    DMReserved2 As Long
    DMPanningWidth As Long
    DMPanningHeight As Long
End Type

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function PrintDialogEx Lib "comdlg32" Alias "PrintDlgExW" (ByRef lpPrintDlgEx As PRINTDLGEX) As Long

Private PropFlags As Long
Private PropMin As Long, PropMax As Long
Private PropFromPage As Long, PropToPage As Long
Private PropPrinterDefault As Boolean

---

Code:

---


Public Function ShowPrinterEx() As CdlPDResultConstants
Dim PDLGEX As PRINTDLGEX, PPAGERANGE As PRINTPAGERANGE, DMODE As DEVMODE, DNAMES As DEVNAMES
Dim lpDevMode As Long, lpDevNames As Long
Dim ObjPrinter As VB.Printer, NewPrinterName As String, Buffer As String
With PDLGEX
.lStructSize = LenB(PDLGEX)
If Not Screen.ActiveForm Is Nothing Then
    .hWndOwner = Screen.ActiveForm.hWnd
Else
    .hWndOwner = GetActiveWindow()
End If
.Flags = PropFlags
.nPageRanges = 1
.nMaxPageRanges = 1
PPAGERANGE.nFromPage = PropFromPage
PPAGERANGE.nToPage = PropToPage
.nMinPage = PropMin
.nMaxPage = PropMax
.lpPageRanges = VarPtr(PPAGERANGE)
Const START_PAGE_GENERAL As Long = &HFFFFFFFF
.nStartPage = START_PAGE_GENERAL
End With
If VB.Printers.Count > 0 And (PDLGEX.Flags And CdlPDReturnDefault) = 0 Then
    With VB.Printer
    DMODE.DMSize = LenB(DMODE)
    Buffer = Left$(.DeviceName, CCHDEVICENAME)
    CopyMemory DMODE.DMDeviceName(0), ByVal StrPtr(Buffer), LenB(Buffer)
    DMODE.DMFields = DM_ORIENTATION Or DM_PAPERSIZE Or DM_COPIES Or DM_DEFAULTSOURCE Or DM_PRINTQUALITY Or DM_COLOR Or DM_DUPLEX Or DM_COLLATE
    DMODE.DMOrientation = .Orientation
    DMODE.DMPaperSize = .PaperSize
    DMODE.DMCopies = .Copies
    DMODE.DMDefaultSource = .PaperBin
    DMODE.DMPrintQuality = .PrintQuality
    DMODE.DMColor = .ColorMode
    DMODE.DMDuplex = .Duplex
    DMODE.DMCollate = IIf((PDLGEX.Flags And CdlPDCollate) <> 0, 1, 0)
    DNAMES.wDriverOffset = 4
    DNAMES.wDeviceOffset = DNAMES.wDriverOffset + Len(.DriverName) + 1
    DNAMES.wOutputOffset = DNAMES.wDeviceOffset + Len(.DeviceName) + 1
    DNAMES.wDefault = 0
    Buffer = Left$(.DriverName & vbNullChar & .DeviceName & vbNullChar & .Port & vbNullChar, CCHDEVNAMESEXTRA)
    CopyMemory DNAMES.wExtra(0), ByVal StrPtr(Buffer), LenB(Buffer)
    PDLGEX.nCopies = .Copies
    PDLGEX.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, LenB(DMODE))
    lpDevMode = GlobalLock(PDLGEX.hDevMode)
    CopyMemory ByVal lpDevMode, DMODE, LenB(DMODE)
    GlobalUnlock PDLGEX.hDevMode
    PDLGEX.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, LenB(DNAMES))
    lpDevNames = GlobalLock(PDLGEX.hDevNames)
    CopyMemory ByVal lpDevNames, DNAMES, LenB(DNAMES)
    GlobalUnlock PDLGEX.hDevNames
    End With
End If
Dim ErrVal As Long
If PropHookEvents = False Then
    ErrVal = PrintDialogEx(PDLGEX)
Else
    Call ComCtlsCdlPDEXSetHook(Me)
    ErrVal = PrintDialogEx(PDLGEX)
    Call ComCtlsCdlPDEXRemoveHook
End If
If ErrVal = S_OK Then
    If PDLGEX.dwResultAction <> CdlPDResultCancel Then
        lpDevMode = GlobalLock(PDLGEX.hDevMode)
        CopyMemory DMODE, ByVal lpDevMode, LenB(DMODE)
        GlobalUnlock PDLGEX.hDevMode
        GlobalFree PDLGEX.hDevMode
        lpDevNames = GlobalLock(PDLGEX.hDevNames)
        CopyMemory DNAMES, ByVal lpDevNames, LenB(DNAMES)
        GlobalUnlock PDLGEX.hDevNames
        GlobalFree PDLGEX.hDevNames
        NewPrinterName = Left$(DMODE.DMDeviceName(), InStr(DMODE.DMDeviceName(), vbNullChar) - 1)
        Dim PrinterFound As Boolean
        If StrComp(VB.Printer.DeviceName, NewPrinterName, vbTextCompare) <> 0 Then
            For Each ObjPrinter In VB.Printers
                If StrComp(ObjPrinter.DeviceName, NewPrinterName, vbTextCompare) = 0 Then
                    Set VB.Printer = ObjPrinter
                    PrinterFound = True
                    Exit For
                End If
            Next ObjPrinter
        Else
            PrinterFound = True
        End If
        If PropPrinterDefault = True Then Call SetPrinterDefault(NewPrinterName)
        If PrinterFound = True Then
            On Error Resume Next
            With VB.Printer
            .Copies = DMODE.DMCopies
            .Duplex = DMODE.DMDuplex
            .Orientation = DMODE.DMOrientation
            .PaperSize = DMODE.DMPaperSize
            .PrintQuality = DMODE.DMPrintQuality
            .ColorMode = DMODE.DMColor
            .PaperBin = DMODE.DMDefaultSource
            End With
            On Error GoTo 0
        End If
        PropFlags = PDLGEX.Flags
        If (PropFlags And CdlPDUseDevModeCopiesAndCollate) <> 0 Then
            If DMODE.DMCollate = 1 And (PropFlags And CdlPDCollate) = 0 Then PropFlags = PropFlags Or CdlPDCollate
        End If
        PropFromPage = PPAGERANGE.nFromPage
        PropToPage = PPAGERANGE.nToPage
        PropMin = PDLGEX.nMinPage
        PropMax = PDLGEX.nMaxPage
        If (PropFlags And (CdlPDReturnDC Or CdlPDReturnIC)) <> 0 Then PropDC = PDLGEX.hDC
        ShowPrinterEx = PDLGEX.dwResultAction
    Else
        If PropCancelError = True Then Err.Raise Number:=CdlCancel, Description:="Cancel was selected."
    End If
Else
    If PDLGEX.hDevMode <> 0 Then GlobalFree PDLGEX.hDevMode
    If PDLGEX.hDevNames <> 0 Then GlobalFree PDLGEX.hDevNames
    Const E_OUTOFMEMORY As Long = &H8007000E, E_INVALIDARG As Long = &H80070057, E_POINTER As Long = &H80004003, E_HANDLE As Long = &H80070006, E_FAIL As Long = &H80004005
    Select Case ErrVal
        Case E_OUTOFMEMORY, E_INVALIDARG, E_POINTER, E_HANDLE, E_FAIL
            Err.Raise Number:=CdlInitFailure, Description:="The PrintDlgEx function failed during initialization."
        Case Else
            Err.Raise Number:=ErrVal, Description:="Unexpected error."
    End Select
End If
End Function

---

Attachment 125639



Attachment 125641

I verified the max length of the printer name is restricted within 30 characters.

Refer to my another two screenshots.


Attachment 125643


Attachment 125645

I tried to define String type instead of byte, but still cannot retrieve the full name of my Printer.
The maximum characters are 30 for both of local and network printer.

I attach a simply demo.

First of all, the instruction:

Code:

---

If Printer.DeviceName <> strNewPrinterName Then

---

return always True, because strNewPrinterName variable is always on upper case, while Printer.DeviceName not.

Second:
on Microsoft DEVMODE structure (Windows) web page:https://msdn.microsoft.com/en-us/lib...or=-2147217396

You read, about member dmDeviceName
A zero-terminated character array that specifies the "friendly" name of the printer or display; for example, "PCL/HP LaserJet" in the case of PCL/HP LaserJet. This string is unique among device drivers. Note that this name may be truncated to fit in the dmDeviceName array.

I don't know is there a different wayto solveyour question, but you may modify the comparison as workaround:

Code:

---

    'If UCase$(objPrinter.DeviceName) = strNewPrinterName Then ' old camparison
    If (UCase$(objPrinter.DeviceName) Like Trim$(strNewPrinterName) & "*") = True Then

---

Surely it could not be 100% accurate, but the probability that two printers have a name with the first 30 characters equal is rather remote.

Perhaps, I've never tried it, you might think to use the Unicode version of DEVMODE:
DEVMODEW structure (Windows Drivers)
https://msdn.microsoft.com/en-us/lib...or=-2147217396

:wave:

Quote:

---

but the probability that two printers have a name with the first 30 characters equal is rather remote.

---

i often see like printername (copy 2), so not totally unlikely

Quote:

---

Originally Posted by gibra

First of all, the instruction:

Code:

---

If Printer.DeviceName <> strNewPrinterName Then

---

return always True, because strNewPrinterName variable is always on upper case, while Printer.DeviceName not.

Second:
on Microsoft DEVMODE structure (Windows) web page:https://msdn.microsoft.com/en-us/lib...or=-2147217396

You read, about member dmDeviceName
A zero-terminated character array that specifies the "friendly" name of the printer or display; for example, "PCL/HP LaserJet" in the case of PCL/HP LaserJet. This string is unique among device drivers. Note that this name may be truncated to fit in the dmDeviceName array.

I don't know is there a different wayto solveyour question, but you may modify the comparison as workaround:

Code:

---

    'If UCase$(objPrinter.DeviceName) = strNewPrinterName Then ' old camparison
    If (UCase$(objPrinter.DeviceName) Like Trim$(strNewPrinterName) & "*") = True Then

---

Surely it could not be 100% accurate, but the probability that two printers have a name with the first 30 characters equal is rather remote.

Perhaps, I've never tried it, you might think to use the Unicode version of DEVMODE:
DEVMODEW structure (Windows Drivers)
https://msdn.microsoft.com/en-us/lib...or=-2147217396

:wave:

---

Quote:

---

If Printer.DeviceName <> strNewPrinterName Then

---

strComp will be better. But the following loop put UCase$ to check every pinter in printers collection, so it is not root cause.

Quote:

---

'If UCase$(objPrinter.DeviceName) = strNewPrinterName Then ' old camparison
If (UCase$(objPrinter.DeviceName) Like Trim$(strNewPrinterName) & "*") = True Then

---

Code:

---

If UCase$(ObjPrinter.DeviceName) Like UCase$(NewPrinterName) & "*" And StrComp(VBA.Left$(ObjPrinter.DeviceName, 30), VBA.Left$(NewPrinterName, 30), vbTextCompare) = 0 Then

---

I am afraid this workaround is not 100% accurate, it is not reliable to check up the first of 30 Characters.

DEVMODE in Krool's CommonDialog is Unicode friendly declaration and Unicode API, I will change the declaration and give a try.

I am not sure why we cannot retrieve FULL name of Printer. The max characters are 30 always regardless of English Characters or Unicode Characters. No wonder why many commercial software which got Preview feature used Own Printer Dialog Form instead of MS ShowPrinter Dialog API Window.

Quote:

---

Choosing a printer name
Windows XP supports the use of long printer names. This allows you to create printer names that contain spaces and special characters. However, if you share a printer over a network, some clients will not recognize or correctly handle the long names, and users may experience problems printing. Also, some programs cannot print to printers with names longer than 31 characters.
For shared printers, the entire qualified name (including the server name, for example \\PRINTER2\PSCRIPT) must be fewer than 31 characters.

•
If you share a printer with a variety of clients on a network, use 31 or fewer characters for printer names, and do not include spaces or special characters in these names.
•
If you share a printer with MS-DOS computers, do not use more than eight characters for the printer's share name. You can lengthen the name by adding a period followed by no more than three characters, but you cannot use spaces in the name.
Several Windows version 3.x programs cannot print to a printer if its name contains more than the specified number of characters and will generate an Access Violation or other message if printing is attempted. Other programs may not print to any printer, even printers with short names, if the default printer's name is too long. To resolve these problems, rename the printers used by these programs with shorter names and make one of the renamed printers the default printer.

---

The link is here.

the local printer name also limit 30 characters from what I tested on Win7.

.NET C#'s PrinterDialog just work fine for longer printer name. .NET reflector shows the class also call PrintDlgEx API to show Printer Dialog.

Quote:

---

[DllImport("comdlg32.dll", CharSet = CharSet.Auto, SetLastError = true)]
public static extern int PrintDlgEx([In] [Out] NativeMethods.PRINTDLGEX lppdex);

---

Code:

---

/// <summary>Copies the relevant information out of the given handle and into the <see cref="T:System.Drawing.Printing.PrinterSettings" />.</summary>
/// <param name="hdevnames">The handle to a Win32 DEVNAMES structure. </param>
/// <exception cref="T:System.ArgumentException">The printer handle is invalid. </exception>
/// <PermissionSet>
///  <IPermission class="System.Drawing.Printing.PrintingPermission, System.Drawing, Version=2.0.3600.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" version="1" Unrestricted="true" />
/// </PermissionSet>
public void SetHdevnames(IntPtr hdevnames)
{
        IntSecurity.AllPrintingAndUnmanagedCode.Demand();
        if (hdevnames == IntPtr.Zero)
        {
                throw new ArgumentException(SR.GetString("InvalidPrinterHandle", new object[]
                {
                        hdevnames
                }));
        }
        IntPtr pDevnames = SafeNativeMethods.GlobalLock(new HandleRef(null, hdevnames));
        this.driverName = PrinterSettings.ReadOneDEVNAME(pDevnames, 0);
        this.printerName = PrinterSettings.ReadOneDEVNAME(pDevnames, 1);
        this.outputPort = PrinterSettings.ReadOneDEVNAME(pDevnames, 2);
        this.PrintDialogDisplayed = true;
        SafeNativeMethods.GlobalUnlock(new HandleRef(null, hdevnames));
}

// System.Drawing.Printing.PrinterSettings
private static string ReadOneDEVNAME(IntPtr pDevnames, int slot)
{
        checked
        {
                int num = Marshal.SystemDefaultCharSize * (int)Marshal.ReadInt16((IntPtr)((long)pDevnames + unchecked((long)checked(slot * 2))));
                return Marshal.PtrToStringAuto((IntPtr)((long)pDevnames + unchecked((long)num)));
        }
}

---

Look into the above code, the printer name is located at pDevnames + 2* ConvertTo16bitInteger(pDevnames+2). I don't know how to convert to VB6 code. Please help.

Code:

---

        'In Krool's CommonDialog ShowPrinterEx
        lpDevMode = GlobalLock(PDLGEX.hDevMode)
        CopyMemory DMODE, ByVal lpDevMode, LenB(DMODE)
        GlobalUnlock PDLGEX.hDevMode
        GlobalFree PDLGEX.hDevMode
        lpDevNames = GlobalLock(PDLGEX.hDevNames)
        CopyMemory DNAMES, ByVal lpDevNames, LenB(DNAMES)
        GlobalUnlock PDLGEX.hDevNames
        GlobalFree PDLGEX.hDevNames
        NewPrinterName = VBA.Left$(DMODE.DMDeviceName(), InStr(DMODE.DMDeviceName(), vbNullChar) - 1)

---

Jonney, per MSDN the EnumPrinters API can return long printer names if a PRINTER_INFO_2 structure (level 2) is passed. Does that help?

Ignore my previous reply, I misread. The problem is that the full name of the selected printer is not returned after the dialog closes, correct?
In that case, per msdn, the full length can be recovered from the DEVNAMES structure... does that work?

Code:

---

Private Declare Function lstrlenA Lib "kernel32" _
                          (ByVal hMem As Long) As Long

...
        Dim lSize As Long, tBytes() As Byte
        lpDevName = GlobalLock(PrintDlg.hDevNames)
        CopyMemory DevName, ByVal lpDevName, 8 ' the 200 extra bytes you added to the structure is incorrect
        lSize = lstrlenA(lpDevName + DevName.wDeviceOffset)
        ReDim tBytes(0 To lSize - 1)
        CopyMemory tBytes(0), ByVal lpDevName + DevName.wDeviceOffset, lSize
        intReturn = GlobalUnlock(PrintDlg.hDevNames)

        Debug.Print "Full Name of Selected Printer: "; StrConv(tBytes(), vbUnicode)
...

---

On a side note. Your sample zip project always crashes for me. The reason for the crash I believe is this line in your sample project:

Code:

---

CopyMemory DevName, ByVal lpDevName, LenB(DevName)

---

LenB(DevName) = 208 and if the number of bytes @ lpDevName < 208 then crash

Your structure definition is wrong. There should be no 'extra' bytes member added in my opinion. Granted that if you are going to provide the DEVNAMES structure, you will need extra bytes, but that should not be part of the structure definition. Why is this important? As is, when you send the PrintDlgEx the DevNames structure, that structure is 208 bytes, but when it returns from the PrintDlgEx, it is changed. And when you use CopyMemory to copy LenB(DevNames), crash. So, how do you add extra bytes without adding them to the structure definition?
1. GlobalAlloc the total number of bytes needed, say 208?
2. Get a pointer via GlobalLock
3. Copy the 8 byte DEVNAMES structure
4. Build a temp array (200 bytes?) that contain the strings you want passed with DEVNAMES
5. Copy that array to the pointer + 8.

--------------------------------------------------------------------------------------
And yet more notes:

I see you are populating the DEVNAMES structure before calling PrintDlgEx. This is not necessary if you want to initialize the dialog to the default printer. If the hDevNames member is zero, the default printer is used

If the PrintDlg.hwndOwner member is zero, on Vista+ I get a different dialog GUI than if it is non-zero, haven't tried it on XP

Quote:

---

Originally Posted by LaVolpe

Ignore my previous reply, I misread. The problem is that the full name of the selected printer is not returned after the dialog closes, correct?
In that case, per msdn, the full length can be recovered from the DEVNAMES structure... does that work?

Code:

---

Private Declare Function lstrlen Lib "kernel32" _
                          (ByVal hMem As Long) As Long

...
        Dim lSize As Long, tBytes() As Byte
        lpDevName = GlobalLock(PrintDlg.hDevNames)
        CopyMemory DevName, ByVal lpDevName, 8 ' the 200 extra bytes you added to the structure is incorrect
        lSize = lstrlen(lpDevName + DevName.wDeviceOffset)
        ReDim tBytes(0 To lSize - 1)
        CopyMemory tBytes(0), ByVal lpDevName + DevName.wDeviceOffset, lSize
        intReturn = GlobalUnlock(PrintDlg.hDevNames)

        Debug.Print "Full Name of Selected Printer: "; StrConv(tBytes(), vbUnicode)
...

---

On a side note. Your sample zip project always crashes for me. The reason for the crash I believe is this line in your sample project:

Code:

---

CopyMemory DevName, ByVal lpDevName, LenB(DevName)

---

LenB(DevName) = 208 and if the number of bytes @ lpDevName < 208 then crash

Your structure definition is wrong. There should be no 'extra' bytes member added in my opinion. Granted that if you are going to provide the DEVNAMES structure, you will need extra bytes, but that should not be part of the structure definition. Why is this important? As is, when you send the PrintDlgEx the DevNames structure, that structure is 208 bytes, but when it returns from the PrintDlgEx, it is changed. And when you use CopyMemory to copy LenB(DevNames), crash. So, how do you add extra bytes without adding them to the structure definition?
1. GlobalAlloc the total number of bytes needed, say 208?
2. Get a pointer via GlobalLock
3. Copy the 8 byte DEVNAMES structure
4. Build a temp array (200 bytes?) that contain the strings you want passed with DEVNAMES
5. Copy that array to the pointer + 8.

--------------------------------------------------------------------------------------
And yet more notes:

I see you are populating the DEVNAMES structure before calling PrintDlgEx. This is not necessary if you want to initialize the dialog to the default printer. If the hDevNames member is zero, the default printer is used

If the PrintDlg.hwndOwner member is zero, on Vista+ I get a different dialog GUI than if it is non-zero, haven't tried it on XP

---

First of all, Thank you very much, Sir.
And, Honestly, Such advanced stuff with memory operation is my weakness. I don't REALLY understand deeply.
The demo I provided has many testing code, it confuse you initially but you went out because you really understood!

Now I see the beautiful Printer name now though it returns weird characters when the printer name is Unicode. I think we should define the structure by byte() instead of String.
With Krool's CommonDialog class, I also saw the beautiful FULL printer name. It is better because the declared structure is Unicode friendly.

One question:
I used SysReAllocString API to get the printer string. Why the string pointer is located at lpDevNames + 8 +18? Please explain a bit.

Quote:

---

NewPrinterName = GetStrFromPtrW4(lpDevNames + 8 + 18)

---

Code:

---


Private Function GetStrFromPtrW4(ByVal Ptr As Long) As String
    'Bonnie West - Benchmarks demo on VBForums
    SysReAllocString VarPtr(GetStrFromPtrW4), Ptr
End Function

Public Function ShowPrinterEx() As CdlPDResultConstants
Dim PDLGEX As PRINTDLGEX, PPAGERANGE As PRINTPAGERANGE, DMODE As DEVMODE, DNAMES As DEVNAMES
Dim lpDevMode As Long, lpDevNames As Long
Dim ObjPrinter As VB.Printer, NewPrinterName As String, Buffer As String
With PDLGEX
.lStructSize = LenB(PDLGEX)
If Not Screen.ActiveForm Is Nothing Then
    .hWndOwner = Screen.ActiveForm.hWnd
Else
    .hWndOwner = GetActiveWindow()
End If
.Flags = PropFlags
.nPageRanges = 1
.nMaxPageRanges = 1
PPAGERANGE.nFromPage = PropFromPage
PPAGERANGE.nToPage = PropToPage
.nMinPage = PropMin
.nMaxPage = PropMax
.nCopies = PropCopies
.lpPageRanges = VarPtr(PPAGERANGE)
Const START_PAGE_GENERAL As Long = &HFFFFFFFF
.nStartPage = START_PAGE_GENERAL
End With
If VB.Printers.Count > 0 And (PDLGEX.Flags And CdlPDReturnDefault) = 0 Then
    With VB.Printer
    DMODE.DMSize = LenB(DMODE)
    Buffer = VBA.Left$(.DeviceName, CCHDEVICENAME)
    CopyMemory DMODE.DMDeviceName(0), ByVal StrPtr(Buffer), LenB(Buffer)
    DMODE.DMFields = DM_ORIENTATION Or DM_PAPERSIZE Or DM_COPIES Or DM_DEFAULTSOURCE Or DM_PRINTQUALITY Or DM_COLOR Or DM_DUPLEX Or DM_COLLATE
    DMODE.DMOrientation = .Orientation
    DMODE.DMPaperSize = PaperSize '.PaperSize
    DMODE.DMCopies = PropCopies ' .Copies
    DMODE.DMDefaultSource = .PaperBin
    DMODE.DMPrintQuality = .PrintQuality
    DMODE.DMColor = .ColorMode
    DMODE.DMDuplex = .Duplex
    DMODE.DMCollate = IIf((PDLGEX.Flags And CdlPDCollate) <> 0, 1, 0)
    PDLGEX.nCopies = .Copies
    PDLGEX.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, LenB(DMODE))
    lpDevMode = GlobalLock(PDLGEX.hDevMode)
    CopyMemory ByVal lpDevMode, DMODE, LenB(DMODE)
    GlobalUnlock PDLGEX.hDevMode
   
    DNAMES.wDriverOffset = 4
    DNAMES.wDeviceOffset = DNAMES.wDriverOffset + Len(.DriverName) + 1
    Debug.Print "DNAMES.wDriverOffset + Len(.DriverName) + 1="; DNAMES.wDriverOffset + Len(.DriverName) + 1
    DNAMES.wOutputOffset = DNAMES.wDeviceOffset + Len(.DeviceName) + 1
    DNAMES.wDefault = 0
    Buffer = VBA.Left$(.DriverName & vbNullChar & .DeviceName & vbNullChar & .Port & vbNullChar, CCHDEVNAMESEXTRA)
    CopyMemory DNAMES.wExtra(0), ByVal StrPtr(Buffer), LenB(Buffer)
    PDLGEX.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, LenB(DNAMES))
    lpDevNames = GlobalLock(PDLGEX.hDevNames)
    CopyMemory ByVal lpDevNames, DNAMES, LenB(DNAMES)
    GlobalUnlock PDLGEX.hDevNames
    End With
End If
Dim ErrVal As Long
If PropHookEvents = False Then
    ErrVal = PrintDialogEx(PDLGEX)
Else
    Call ComCtlsCdlPDEXSetHook(Me)
    ErrVal = PrintDialogEx(PDLGEX)
    Call ComCtlsCdlPDEXRemoveHook
End If
If ErrVal = S_OK Then
    If PDLGEX.dwResultAction <> CdlPDResultCancel Then
        lpDevMode = GlobalLock(PDLGEX.hDevMode)
        CopyMemory DMODE, ByVal lpDevMode, LenB(DMODE)
        GlobalUnlock PDLGEX.hDevMode
        GlobalFree PDLGEX.hDevMode
       
        lpDevNames = GlobalLock(PDLGEX.hDevNames)
        CopyMemory DNAMES, ByVal lpDevNames, 8 'LenB(DNAMES)
        NewPrinterName = GetStrFromPtrW4(lpDevNames + 8 + 18)
       
        GlobalUnlock PDLGEX.hDevNames
        GlobalFree PDLGEX.hDevNames
        'NewPrinterName = VBA.Left$(DMODE.DMDeviceName, InStr(DMODE.DMDeviceName, vbNullChar) - 1)
           
        Dim PrinterFound As Boolean
        If StrComp(VB.Printer.DeviceName, NewPrinterName, vbTextCompare) <> 0 Then
            For Each ObjPrinter In VB.Printers
                If StrComp(ObjPrinter.DeviceName, NewPrinterName, vbTextCompare) = 0 Then
                    Set VB.Printer = ObjPrinter
                    PrinterFound = True
                    Exit For
                End If
            Next ObjPrinter
        Else
            PrinterFound = True
        End If
        If PropPrinterDefault = True Then Call SetPrinterDefault(NewPrinterName)
        If PrinterFound = True Then
            On Error Resume Next
            With VB.Printer
            .Copies = DMODE.DMCopies
            .Duplex = DMODE.DMDuplex
            .Orientation = DMODE.DMOrientation
            .PaperSize = DMODE.DMPaperSize
            .PrintQuality = DMODE.DMPrintQuality
            .ColorMode = DMODE.DMColor
            .PaperBin = DMODE.DMDefaultSource
            End With
            On Error GoTo 0
        End If
        PropFlags = PDLGEX.Flags
        If (PropFlags And CdlPDUseDevModeCopiesAndCollate) <> 0 Then
            If DMODE.DMCollate = 1 And (PropFlags And CdlPDCollate) = 0 Then PropFlags = PropFlags Or CdlPDCollate
        End If
        PropFromPage = PPAGERANGE.nFromPage
        PropToPage = PPAGERANGE.nToPage
        PropMin = PDLGEX.nMinPage
        PropMax = PDLGEX.nMaxPage
        If (PropFlags And (CdlPDReturnDC Or CdlPDReturnIC)) <> 0 Then PropDC = PDLGEX.hDc
        ShowPrinterEx = PDLGEX.dwResultAction
    Else
        If PropCancelError = True Then Err.Raise Number:=CdlCancel, Description:="Cancel was selected."
    End If
Else
    If PDLGEX.hDevMode <> 0 Then GlobalFree PDLGEX.hDevMode
    If PDLGEX.hDevNames <> 0 Then GlobalFree PDLGEX.hDevNames
    Const E_OUTOFMEMORY As Long = &H8007000E, E_INVALIDARG As Long = &H80070057, E_POINTER As Long = &H80004003, E_HANDLE As Long = &H80070006, E_FAIL As Long = &H80004005
    Select Case ErrVal
        Case E_OUTOFMEMORY, E_INVALIDARG, E_POINTER, E_HANDLE, E_FAIL
            Err.Raise Number:=CdlInitFailure, Description:="The PrintDlgEx function failed during initialization."
        Case Else
            Err.Raise Number:=ErrVal, Description:="Unexpected error."
    End Select
End If
End Function

---

Code:

---

Private Type PRINTDLGEX
lStructSize As Long
hWndOwner As Long
hDevMode As Long
hDevNames As Long
hDc As Long
Flags As Long
Flags2 As Long
ExclusionFlags As Long
nPageRanges As Long
nMaxPageRanges As Long
lpPageRanges As Long
nMinPage As Long
nMaxPage As Long
nCopies As Long
hInstance As Long
lpPrintTemplateName As Long
lpCallback As Long
nPropertyPages As Long
lphPropertyPages As Long
nStartPage As Long
dwResultAction As Long
End Type
Private Const CCHDEVNAMESEXTRA As Long = 100
Private Type DEVNAMES
wDriverOffset As Integer
wDeviceOffset As Integer
wOutputOffset As Integer
wDefault As Integer
wExtra(0 To ((CCHDEVNAMESEXTRA * 2) - 1)) As Byte
End Type
Private Const CCHDEVICENAME As Long = 32
Private Const CCHFORMNAME As Long = 32
Private Const DM_ORIENTATION As Long = &H1
Private Const DM_PAPERSIZE As Long = &H2
Private Const DM_COPIES As Long = &H100
Private Const DM_DEFAULTSOURCE As Long = &H200
Private Const DM_PRINTQUALITY As Long = &H400
Private Const DM_COLOR As Long = &H800
Private Const DM_DUPLEX As Long = &H1000
Private Const DM_COLLATE As Long = &H8000&
Private Type DEVMODE
DMDeviceName(0 To ((CCHDEVICENAME * 2) - 1)) As Byte
DMSpecVersion As Integer
DMDriverVersion As Integer
DMSize As Integer
DMDriverExtra As Integer
DMFields As Long
DMOrientation As Integer
DMPaperSize As Integer
DMPaperLength As Integer
DMPaperWidth As Integer
DMScale As Integer
DMCopies As Integer
DMDefaultSource As Integer
DMPrintQuality As Integer
DMColor As Integer
DMDuplex As Integer
DMYResolution As Integer
DMTTOption As Integer
DMCollate As Integer
DMFormName(0 To ((CCHFORMNAME * 2) - 1)) As Byte
DMLogPixels As Integer
DMBitsPerPel As Long
DMPelsWidth As Long
DMPelsHeight As Long
DMDisplayFlags As Long
DMDisplayFrequency As Long
DMICMMethod As Long
DMICMIntent As Long
DMMediaType As Long
DMDitherType As Long
DMReserved1 As Long
DMReserved2 As Long
DMPanningWidth As Long
DMPanningHeight As Long
End Type

Private Declare Function PrintDialogEx Lib "comdlg32" Alias "PrintDlgExW" (ByRef lpPrintDlgEx As PRINTDLGEX) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long

Public Property Get Min() As Long
Min = PropMin
End Property

Public Property Let Min(ByVal value As Long)
If value < 0 Then Err.Raise 380
PropMin = value
End Property

Public Property Get Max() As Long
Max = PropMax
End Property

Public Property Let Max(ByVal value As Long)
If value < 0 Then Err.Raise 380
PropMax = value
End Property

Public Property Get FromPage() As Long
FromPage = PropFromPage
End Property

Public Property Let FromPage(ByVal value As Long)
If value < 0 Then Err.Raise 380
PropFromPage = value
End Property

Public Property Get ToPage() As Long
ToPage = PropToPage
End Property

Public Property Let ToPage(ByVal value As Long)
If value < 0 Then Err.Raise 380
PropToPage = value
End Property

Public Property Get Copies() As Long '***Add
Copies = PropCopies
End Property

Public Property Let Copies(ByVal value As Long) '***Add
If value < 0 Then Err.Raise 380
PropCopies = value
End Property

Public Property Get PaperSize() As Long '***Add
PaperSize = PropPaperSize
End Property

Public Property Let PaperSize(ByVal value As Long) '***Add
If value < 0 Then Err.Raise 380
PropPaperSize = value
End Property

---

Per MSDN, when PrintDlgExW is used, all strings must be unicode. When PrintDlgExA is used strings must be ANSI. This includes any strings you provide as strings or in a byte array. This also includes any strings/pointers returned from the API. When using the W version, pass the structure by VarPtr() and redefine your API

Code:

---

Private Declare Function PrintDialogW Lib "comdlg32.dll" Alias "PrintDlgW" _
                          (ByVal pPrintdlg As Long) As Long

...
If PrintDialogW(VarPtr(PrintDlg)) Then

...

---

I think you are right. You will want to use arrays for the dmDeviceName & dmFormName members. For ANSI version, sized 32 and 64 for unicode. I don't have time to play with this today. After reviewing the class you included in your zip file, I have seen other things that can lead to problems

Quote:

---

Originally Posted by Jonney

I used SysReAllocString API to get the printer string. Why the string pointer is located at lpDevNames + 8 +18? Please explain a bit.

---

Per msdn, the correct structure is

Code:

---

Private Type DEVNAMES_TYPE
    wDriverOffset As Integer
    wDeviceOffset As Integer
    wOutputOffset As Integer
    wDefault As Integer
End Type

---

That structure is 8 bytes: 4 integers of 2 bytes each. Each integer is an offset from the pointer you get from GlobalLock(.hDevNames). Let's just assume these values are given to us for those members:
wDriverOffset = 8
wDeviceOffset = 18
wOutputOffset = 32
wDefault = 50

This tells us that the printer name starts at the memory address of the pointer + 18 bytes. The wDefault string starts at the pointer + 50 bytes, etc, etc. The DEVNAMES structure is just 8 bytes, but the global pointer you were given by the API is the 8 bytes + the total bytes needed to store the strings. They are just packed/stacked together

Does that help?

Quote:

---

Originally Posted by LaVolpe

Per msdn, the correct structure is

Code:

---

Private Type DEVNAMES_TYPE
    wDriverOffset As Integer
    wDeviceOffset As Integer
    wOutputOffset As Integer
    wDefault As Integer
End Type

---

That structure is 8 bytes: 4 integers of 2 bytes each. Each integer is an offset from the pointer you get from GlobalLock(.hDevNames). Let's just assume these values are given to us for those members:
wDriverOffset = 8
wDeviceOffset = 18
wOutputOffset = 32
wDefault = 50

This tells us that the printer name starts at the memory address of the pointer + 18 bytes. The wDefault string starts at the pointer + 50 bytes, etc, etc. The DEVNAMES structure is just 8 bytes, but the global pointer you were given by the API is the 8 bytes + the total bytes needed to store the strings. They are just packed/stacked together

Does that help?

---

Quote:

---

Let's just assume these values are given to us for those members:
wDriverOffset = 8
wDeviceOffset = 18
wOutputOffset = 32
wDefault = 50

---

"Assume"? those are exact memory address. How you get the 8,18,32,50?

I made them up for the example. They can change depending on which printer was selected and/or however the print dialog organizes the memory it allocates and sends to you through the hDevNames global pointer.

Quote:

---

Originally Posted by LaVolpe

I made them up for the example. They can change depending on which printer was selected and/or however the print dialog organizes the memory it allocates and sends to you through the hDevNames global pointer.

---

Refer to #10 code, Is it reliable to use GetStrFromPtrW4(lpDevNames + 8 + 18) to retrieve the printer name?

Quote:

---

CopyMemory DNAMES, ByVal lpDevNames, 8 'LenB(DNAMES)
NewPrinterName = GetStrFromPtrW4(lpDevNames + 8 + 18)

---

Have never used GetStrFromPtrW4. But no, the parameters are not correct. You cannot hard code the offsets

Here is an example, using Unicode version

Code:

---

Private Declare Function lstrlenW Lib "kernel32" _
                          (ByVal hMem As Long) As Long

Private Declare Function PrintDialogW Lib "comdlg32.dll" Alias "PrintDlgW" _
                          (ByVal pPrintdlg As Long) As Long

Private Type DEVMODE_TYPE
    dmDeviceName(1 To CCHDEVICENAME * 2) As Byte '32 ANSI 64  Unicode
    ...
    dmFormName(1 To CCHFORMNAME * 2) As Byte '32 ANSI 64 Unicode
    ...
End Type

...
    If PrintDialogW(VarPtr(PrintDlg)) Then

        Dim lSize As Long, tBytes() As Byte
        lpDevName = GlobalLock(PrintDlg.hDevNames)
        CopyMemory DevName, ByVal lpDevName, 8 ' the 200 extra bytes you added to the structure is incorrect
        lSize = lstrlenW(lpDevName + DevName.wDeviceOffset * 2)
        strNewPrinterName = String$(lSize, vbNullChar)
        CopyMemory ByVal StrPtr(strNewPrinterName), ByVal lpDevName + DevName.wDeviceOffset * 2, lSize * 2
        intReturn = GlobalUnlock(PrintDlg.hDevNames)

        Debug.Print "Full Name of Selected Printer: "; strNewPrinterName
...

---

Notice that when retrieving the full printer name, that the offsets in the DEVNAMES members are * 2. This is because the offsets are not provided as bytes, they are provided as characters and unicode is 2 bytes per character

The DEVNAMES structure is referenced differently depending on ANSI or unicode version of API being called. The offsets are measured in characters from the beginning of the structure, not bytes from beginning of structure

ANSI: global pointer data is 1 byte per character
- Retrieving strings: Use pointer + DevName.[offset], lstrLenA to get length
- Setting strings: string data must be 1 byte per character, 1st position for any DevName.[offset] member is 8
i.e., DevName.wDeviceOffset = 8. Copy the default printer name + null char to global pointer + 8
Note: So, 1st position is (8 bytes from start of structure) / (1 byte per character) = offset of 8

Unicode: global pointer data is 2 bytes per character
- Retrieving strings: Use pointer + DevName.[offset] * 2, lstrLenW to get length
- Setting strings: string data must be 2 bytes per character, 1st position for any DevName.[offset] member is 4
i.e., DevName.wDeviceOffset = 4. Copy the default printer name + 2 null chars to global pointer + 8
Note: So, 1st position is (8 bytes from start of structure) / (2 bytes per character) = offset of 4

Jonney, here's something to play with. But see my previous reply regarding DEVNAMES

Here's a generic unicode/ansi version of your ShowPrinter function

Code:

---

Public Function ShowPrinter(Optional ByVal hWndOwner As Long) As Boolean

    Dim PrintDlg As PRINTDLG_TYPE
    Dim DevMode As DEVMODE_TYPE
    Dim DevName As DEVNAMES_TYPE
    Dim lpDevMode As Long, lpDevName As Long
    Dim lngReturn As Long
    Dim objPrinter As Printer
    Dim strNewPrinterName As String
    Dim blnCancel As Boolean
    Dim lSize As Long, tBytes() As Byte
    Dim lTrailingBytes As Long

    With PrintDlg
        .lStructSize = Len(PrintDlg)
        .hWndOwner = hWndOwner
        .Flags = Flags
        .nMinPage = intMinPage
        .nFromPage = intFromPage
        .nToPage = intToPage
        .nMaxPage = intMaxPage
    End With

    ' if you want to choose a different printer to be selected as default
    ' add a property to allow user to select printer beforehand, may need EnumPrinters to fill a list
    ' for example, we'll say the  property name is m_DefaultPrinter (string)
    If Len(m_DefaultPrinter) > 0 Then
        If m_Unicode Then
            lSize = Len(m_DefaultPrinter) * 2 + 2
            tBytes() = m_DefaultPrinter & vbNullChar
            DevName.wDeviceOffset = 4
            DevMode.dmDeviceName(1) = 48 ' dummy to force dmDeviceName <> DevNames
        Else
            lSize = Len(m_DefaultPrinter) + 1
            tBytes() = StrConv(m_DefaultPrinter & vbNullChar, vbFromUnicode)
            DevName.wDeviceOffset = 8
            DevMode.dmDeviceName(33) = 48 ' dummy to force dmDeviceName <> DevNames
        End If
        PrintDlg.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, lSize + 8)
        lpDevName = GlobalLock(PrintDlg.hDevNames)
        If lpDevName Then
            CopyMemory ByVal lpDevName, DevName, 8
            CopyMemory ByVal lpDevName + 8, tBytes(0), lSize
            GlobalUnlock PrintDlg.hDevNames
            Erase tBytes()
        End If
    End If
   
    On Error Resume Next ' some of your test code?
    DevMode.dmFields = DM_ORIENTATION Or DM_DUPLEX
    DevMode.dmOrientation = Printer.Orientation
    DevMode.dmDuplex = Printer.Duplex
    On Error GoTo 0

    DevMode.dmSpecVersion = &H320   
    DevMode.dmSize = LenB(DevMode)
    If m_Unicode = False Then DevMode.dmSize = DevMode.dmSize - CCHDEVICENAME - CCHFORMNAME
   
    PrintDlg.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, DevMode.dmSize)
    lpDevMode = GlobalLock(PrintDlg.hDevMode)
    If lpDevMode Then
        If m_Unicode Then
            CopyMemory ByVal lpDevMode, DevMode, DevMode.dmSize
        Else
            ' number of bytes from dmUnusedPadding to end of the structure
            lTrailingBytes = VarPtr(DevMode) + Len(DevMode) - VarPtr(DevMode.dmUnusedPadding)
            ' copy 32 bytes of both dmDeviceName/dmFormName + 38 bytes (up to and including dmCollate)
            CopyMemory ByVal lpDevMode, ByVal VarPtr(DevMode) + CCHDEVICENAME, DevMode.dmSize - lTrailingBytes
            ' copy all members including and after dmUnusedPadding
            CopyMemory ByVal lpDevMode + DevMode.dmSize - lTrailingBytes, ByVal VarPtr(DevMode.dmUnusedPadding), lTrailingBytes
        End If
        lngReturn = GlobalUnlock(PrintDlg.hDevMode)
    End If

    If m_Unicode Then
        lngReturn = PrintDialogW(VarPtr(PrintDlg))
    Else
        lngReturn = PrintDialog(PrintDlg)
    End If
   
    If lngReturn = 0 Then ' user canceled?
        If PrintDlg.hDevMode Then GlobalFree PrintDlg.hDevMode
        If PrintDlg.hDevNames Then GlobalFree PrintDlg.hDevNames
        blnCancel = True
        If CancelError Then _
          Err.Raise cdlCancel, "LM PrintDialog", "Cancel."
    Else
   
        ' get full printer name to assign to VB.Printers object
        If Not (PrintDlg.hDevNames = 0 Or PrintDlg.hDevMode = 0) Then
            lpDevName = GlobalLock(PrintDlg.hDevNames)
            CopyMemory DevName, ByVal lpDevName, 8
            If m_Unicode Then
                lSize = lstrlenW(lpDevName + DevName.wDeviceOffset * 2)
                strNewPrinterName = String$(lSize, vbNullChar)
                CopyMemory ByVal StrPtr(strNewPrinterName), ByVal lpDevName + DevName.wDeviceOffset * 2, lSize * 2
            Else
                lSize = lstrlenA(lpDevName + DevName.wDeviceOffset)
                ReDim tBytes(0 To lSize - 1)
                CopyMemory tBytes(0), ByVal lpDevName + DevName.wDeviceOffset, lSize
                strNewPrinterName = StrConv(tBytes(), vbUnicode)
                Erase tBytes()
            End If
            GlobalUnlock PrintDlg.hDevNames
            GlobalFree PrintDlg.hDevNames
           
            lpDevMode = GlobalLock(PrintDlg.hDevMode)
            If m_Unicode Then
                CopyMemory DevMode, ByVal lpDevMode, DevMode.dmSize
            Else
                lSize = DevMode.dmSize
                CopyMemory ByVal VarPtr(DevMode) + CCHDEVICENAME, ByVal lpDevMode, lSize - lTrailingBytes
                CopyMemory ByVal VarPtr(DevMode.dmUnusedPadding), ByVal lpDevMode + lSize - lTrailingBytes, lTrailingBytes
            End If
            GlobalUnlock PrintDlg.hDevMode
            GlobalFree PrintDlg.hDevMode
           
            On Error Resume Next
            For Each objPrinter In Printers
                If StrComp(objPrinter.DeviceName, strNewPrinterName, vbTextCompare) = 0 Then
                    Set Printer = objPrinter
                    Exit For
                End If
            Next objPrinter
            With Printer
                .Copies = DevMode.dmCopies
                .Duplex = DevMode.dmDuplex
                .Orientation = DevMode.dmOrientation
            End With
            On Error GoTo 0
           
        Else
            If PrintDlg.hDevNames Then GlobalFree PrintDlg.hDevNames
            If PrintDlg.hDevMode Then GlobalFree PrintDlg.hDevMode
            ' something's wrong, should have hDevNames & hDevMode values
            Err.Raise cdlCancel, "LM PrintDialog", "Cancel."
        End If
    End If

    ShowPrinter = Not blnCancel

End Function

---

Also, here are changes to API and TYPE declarations. Note that I am using the same DEVMODE structure for both ANSI/Unicode. When ANSI is used, the code in the ShowPrinter function customizes copying it to a global pointer for ANSI use

Code:

---

Private Declare Function lstrlenA Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function PrintDialog Lib "comdlg32.dll" Alias "PrintDlgA" _
                          (pPrintdlg As PRINTDLG_TYPE) As Long
Private Declare Function PrintDialogW Lib "comdlg32.dll" Alias "PrintDlgW" _
                          (ByVal pPrintdlg As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long
Private Declare Function IsWindowUnicode Lib "user32.dll" (ByVal hWnd As Long) As Long

Private Type DEVMODE_TYPE ' https://msdn.microsoft.com/en-us/library/windows/desktop/dd183565%28v=vs.85%29.aspx
    dmDeviceName(1 To CCHDEVICENAME * 2) As Byte
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer            ' note: from dmSpecVersion to dmCollate, inclusively, 38 bytes
    dmFormName(1 To CCHFORMNAME * 2) As Byte
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long      ' note: from dmUnusedPadding to dmDisplayFrequency, inclusively, 20 bytes
    ' there are up to 32 additional bytes of extended data as needed
End Type

Private m_Unicode As Boolean
Private m_DefaultPrinter As String

---

Add this line to your class initialize event

Code:

---

m_Unicode = CBool(IsWindowUnicode(GetDesktopWindow))

---

I am studying...

Your code is for PrintDlgW not PrintDlgEx.
Please add the ShowPrinter and ShowPrinterEx in your classic OpenFile/SaveAsFile class. Thanks.

Quote:

---

Originally Posted by Jonney

I am studying...

Your code is for PrintDlgW not PrintDlgEx.

---

I was simply using the class you gave us in post #3 above. Should not be difficult to enhance it for the newer API

Quote:

---

Originally Posted by Jonney

Please add the ShowPrinter and ShowPrinterEx in your classic OpenFile/SaveAsFile class. Thanks.

---

Not appropriate. If I were to wrap a class around the function, I'd create a separate class not add it to the open/save dialog class. Same would apply for the color selection dialog. But this isn't really an interest for me at this time. I just thought I could help you get the full printer name and answer some of your questions regarding using the structures for that API

Quote:

---

Originally Posted by LaVolpe

Not appropriate. If I were to wrap a class around the function, I'd create a separate class not add it to the open/save dialog class. Same would apply for the color selection dialog. But this isn't really an interest for me at this time. I just thought I could help you get the full printer name and answer some of your questions regarding using the structures for that API

---

Thank you very much,Sir.

Quote:

---

Originally Posted by LaVolpe

Not appropriate. If I were to wrap a class around the function, I'd create a separate class not add it to the open/save dialog class. Same would apply for the color selection dialog. But this isn't really an interest for me at this time. I just thought I could help you get the full printer name and answer some of your questions regarding using the structures for that API

---

Oh,oh, the full printer name in Krool's Unicode friendly CommonDialog class can be retrieved by:

Code:

---

NewPrinterName = Mid$(DNAMES.wExtra, _
                          DNAMES.wDeviceOffset - DNAMES.wDriverOffset + 1)
NewPrinterName = VBA.Left$(NewPrinterName, _
                          InStr(NewPrinterName, Chr$(0)) - 1)

---

FYI, For those who visit my thread,VBAccelerator also has comprehensive CommonDialog Class at : http://www.vbaccelerator.com/home/VB...ull_Source.asp

The addressing for retrieve Printer name is something like C# PrinterDialog class (Reflector shown):

Quote:

---

m_sDevice = getDevNameString(ptrDevNames, tDevNames.wDeviceOffset)

---

Code:

---

Private Function getDevNameString( _
      ByVal ptrDevNames As Long, _
      ByVal ptrOffset As Long _
  )
  Dim ptr As Long
  Dim lSize As Long
  Dim b() As Byte
     
  ptr = UnsignedAdd(ptrDevNames, ptrOffset)
  lSize = lstrlenPtr(ptr)
  If (lSize > 0) Then
      ReDim b(0 To lSize - 1) As Byte
      CopyMemory b(0), ByVal ptr, lSize
      getDevNameString = StrConv(b, vbUnicode)
  End If
End Function

Private Function UnsignedAdd(Start As Long, Incr As Long) As Long
' This function is useful when doing pointer arithmetic,
' but note it only works for positive values of Incr

  If Start And &H80000000 Then 'Start < 0
      UnsignedAdd = Start + Incr
  ElseIf (Start Or &H80000000) < -Incr Then
      UnsignedAdd = Start + Incr
  Else
      UnsignedAdd = (Start + &H80000000) + (Incr + &H80000000)
  End If
 
End Function

---