Solved

Can't build Simple Printer Select List in Access97?

Posted on 2000-02-28
13
304 Views
Last Modified: 2008-02-20
I want the users to be presented with a simple listbox in Access97 with the names of the printers in their windows control panel printer list.  When they click one it should become the new default printer so anything they then click the quick PRINT button on will go to this selected printer.  (working VBA code to do this is the quick answer for points)

Lacking that, here is the discussion for us to review as a group of VB/VBA experts:

I'd like to avoid using the common dialog because of the bugs with it not always setting the default to the new choice and also not everyone HAS the common dialog so the API is really ideal and what is needed for this default printer selector.  I've got the code to do this in VB and it works great but this simple code

   for each x in printers

which works great in VB6, gives me an error in Access97 saying "printers" is not a valid variable (object) in Access97?  So how DO you get the list of printer names in Access?  Can we access the Printers Collection somehow from within Access97?

For general knowledge and reference the VB version of the "PRINTERS COLLECTION" acts differently on NT than on Windows95.  The Printers.Port is what gets set to default for 95/98 while the Printers.DeviceName is what is needed to set default printer on NT4!  Anyone else noticed this?

0
Comment
Question by:VBExpert
  • 7
  • 3
  • 3
13 Comments
 
LVL 25

Expert Comment

by:clockwatcher
Comment Utility
0
 

Author Comment

by:VBExpert
Comment Utility
Yes this returns the verbose printer name but thats not the name I can "Copy" to using like the Windows API to copy say a PCL file to.  To use that name which I also use to set my default printer requires a name which looks like

"\\server-05\hplj5"

instead of

"HP LaserJet 5 East Wing"

Doesn't it?  I may just need some more help linking the names or handles returned ion the first link code which I have working fine to the second code link you provided.  

If it's complicated or a big deal I will increase the points just ask..
0
 

Author Comment

by:VBExpert
Comment Utility
For the record and everyones information and convenience, I will paste the code from those links.  

So many times I go back to read old solutions and pay points to read them and these links to places like Microsoft especially seem to go out of date VERY quickly.  Its frustrating and hurts the EE value and usefulness in the long run failing to actually paste code and plugging in dated links.  

with that said here is the text from those links

Option Compare Database
Option Explicit

      Const PRINTER_ENUM_CONNECTIONS = &H4
      Const PRINTER_ENUM_LOCAL = &H2

      Type PRINTER_INFO_1
         flags As Long
         pDescription As String
         PName As String
         PComment As String
      End Type

      Type PRINTER_INFO_4
         pPrinterName As String
         pServerName As String
         Attributes As Long
      End Type

Declare Function EnumPrinters Lib "winspool.drv" Alias _
   "EnumPrintersA" (ByVal flags As Long, ByVal name As String, _
   ByVal Level As Long, pPrinterEnum As Long, ByVal cdBuf As Long, _
   pcbNeeded As Long, pcReturned As Long) As Long
   
Declare Function PtrToStr Lib "Kernel32" Alias "lstrcpyA" _
   (ByVal RetVal As String, ByVal Ptr As Long) As Long
   
Declare Function StrLen Lib "Kernel32" Alias "lstrlenA" _
   (ByVal Ptr As Long) As Long


      Sub EnumeratePrinters1()
      Dim Success As Boolean, cbRequired As Long, cbBuffer As Long
      Dim Buffer() As Long, nEntries As Long
      Dim I As Long, PFlags As Long, PDesc As String, PName As String
      Dim PComment As String, Temp As Long
         cbBuffer = 3072
         ReDim Buffer((cbBuffer \ 4) - 1) As Long
         Success = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
                               PRINTER_ENUM_LOCAL, _
                               vbNullString, _
                               1, _
                               Buffer(0), _
                               cbBuffer, _
                               cbRequired, _
                               nEntries)
         If Success Then
            If cbRequired > cbBuffer Then
               cbBuffer = cbRequired
               Debug.Print "Buffer too small.  Trying again with " & _
                        cbBuffer & " bytes."
               ReDim Buffer(cbBuffer \ 4) As Long
               Success = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
                                   PRINTER_ENUM_LOCAL, _
                                   vbNullString, _
                                   1, _
                                   Buffer(0), _
                                   cbBuffer, _
                                   cbRequired, _
                                   nEntries)
               If Not Success Then
                  Debug.Print "Error enumerating printers."
                  Exit Sub
               End If
            End If
         Debug.Print "There are " & nEntries & _
                      " local and connected printers."
         For I = 0 To nEntries - 1
            PFlags = Buffer(4 * I)
            PDesc = Space$(StrLen(Buffer(I * 4 + 1)))
            Temp = PtrToStr(PDesc, Buffer(I * 4 + 1))
            PName = Space$(StrLen(Buffer(I * 4 + 2)))
            Temp = PtrToStr(PName, Buffer(I * 4 + 2))
            PComment = Space$(StrLen(Buffer(I * 4 + 2)))
            Temp = PtrToStr(PComment, Buffer(I * 4 + 2))
            Debug.Print PFlags, PDesc, PName, PComment
         Next I
         Else
            Debug.Print "Error enumerating printers."
         End If
      End Sub

      Sub EnumeratePrinters4()
      Dim Success As Boolean, cbRequired As Long, cbBuffer As Long
      Dim Buffer() As Long, nEntries As Long
      Dim I As Long, PName As String, SName As String
      Dim Attrib As Long, Temp As Long
         cbBuffer = 3072
         ReDim Buffer((cbBuffer \ 4) - 1) As Long
         Success = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
                               PRINTER_ENUM_LOCAL, _
                               vbNullString, _
                               4, _
                               Buffer(0), _
                               cbBuffer, _
                               cbRequired, _
                               nEntries)
         If Success Then
            If cbRequired > cbBuffer Then
               cbBuffer = cbRequired
               Debug.Print "Buffer too small.  Trying again with " & _
                        cbBuffer & " bytes."
               ReDim Buffer(cbBuffer \ 4) As Long
               Success = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
                                   PRINTER_ENUM_LOCAL, _
                                   vbNullString, _
                                   4, _
                                   Buffer(0), _
                                   cbBuffer, _
                                   cbRequired, _
                                   nEntries)
               If Not Success Then
                  Debug.Print "Error enumerating printers."
                  Exit Sub
               End If
            End If
            Debug.Print "There are " & nEntries & _
                      " local and connected printers."
            For I = 0 To nEntries - 1
            PName = Space$(StrLen(Buffer(I * 3)))
            Temp = PtrToStr(PName, Buffer(I * 3))
            SName = Space$(StrLen(Buffer(I * 3 + 1)))
            Temp = PtrToStr(SName, Buffer(I * 3 + 1))
            Attrib = Buffer(I * 3 + 2)
            Debug.Print "Printer: " & PName, "Server: " & SName, _
                        "Attributes: " & Hex$(Attrib)
            Next I
         Else
            Debug.Print "Error enumerating printers."
         End If
      End Sub
'To test this function, type the following line in the Debug window, and then press ENTER:
'EnumeratePrinters1
'If you are using Microsoft Windows NT, type:
'EnumeratePrinters4

'   // This code uses a sample profile string of "My Printer,HPPCL5MS,lpt1:"
'   // To get the default printer for Windows 3.1, Windows 3.11,
'   // Windows 95, and Windows NT use:
'GetProfileString("windows", "device", ",,,", buffer, sizeof(buffer));

'   -----

'   // To set the default printer for Windows 3.1 and Windows 3.11 use:
'   WriteProfileString("windows", "device", "My Printer,HPPCL5MS,lpt1:")
'   SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, 0L);

'   -----

'   // To set the default printer for Windows 95 use:
'   WriteProfileString("windows", "device", "My Printer,HPPCL5MS,lpt1:");
'   SendMessageTimeout(HWND_BROADCAST, WM_WININICHANGE, 0L,
'   (LPARAM)(LPCTSTR)"windows", SMTO_NORMAL, 1000, NULL);

'   -----

'   // To set the default printer for Windows NT use:
'   /* Note printer driver is usually WINSPOOL under Windows NT */
'   WriteProfileString("windows", "device", "My Printer,WINSPOOL,lpt1:");

'  SendMessageTimeout(HWND_BROADCAST, WM_WININICHANGE, 0L, 0L,
'  SMTO_NORMAL, 1000, NULL);
0
 

Author Comment

by:VBExpert
Comment Utility
unlike in the example they gave, when I run it under win95, it looks like this which does not include the \\ network name:

EnumeratePrinters1
There are 4 local and connected printers.
 8388608      HP LaserJet 4P,HP LaserJet 4P,            HP LaserJet 4P              HP LaserJet 4P
 8388608      HP LaserJet 5P Washington,HP LaserJet 5P, HP LaserJet 5P Washington   HP LaserJet 5P Washington
 8388608      HP LaserJet 8000 Series PCL 6,HP LaserJet 8000 Series PCL 6,          HP LaserJet 8000 Series PCL 6             HP LaserJet 8000 Series PCL 6
 8388608      HP LaserJet 4050 Series PCL 6,HP LaserJet 4050 Series PCL 6,          HP LaserJet 4050 Series PCL 6             HP LaserJet 4050 Series PCL 6

0
 
LVL 25

Accepted Solution

by:
clockwatcher earned 100 total points
Comment Utility
Sorry, I didn't have time to actually write the code up for you before-- so I just posted a couple of links to get you pointed in the right direction.

Now that I've found a few minutes I put the code together for you.  I haven't had the time to test it on NT.

You can download a zipped up database containing a form and the code at:

  http://experts-exchange.yahright.com/enumprinters/enumprinters.zip

Here's the code:

Option Compare Database
Option Explicit

Private Const PRINTER_ENUM_CONNECTIONS = &H4
Private Const PRINTER_ENUM_LOCAL = &H2
Private Const HWND_BROADCAST = &HFFFF&
Private Const WM_WININICHANGE = &H1A
Private Const SMTO_NORMAL = &H0

Private Type PRINTER_INFO_2
    pServerName As Long
    pPrinterName As Long
    pShareName As Long
    pPortName As Long
    pDriverName As Long
    pComment As Long
    pLocation As Long
    otherBytes(55) As Byte      'Not interested in the rest of the structure
End Type


Private Declare Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" _
   (ByVal flags As Long, ByVal name As String, _
   ByVal Level As Long, pPrinterEnum As Any, ByVal cdBuf As Long, _
   pcbNeeded As Long, pcReturned As Long) As Long
   
Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyA" _
   (ByVal RetVal As String, ByVal Ptr As Long) As Long
   
Private Declare Function GetLastError Lib "kernel32" () As Long

Private Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As String, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long


Public Function CreatePrinterList() As String

    'Returns printer list in two column Access combobox format
    'First column is printer name, second is profile string
   
    Const BUFFER_INITIAL_SIZE = 1024

    Dim Success As Boolean, cbRequired As Long
    Dim Buffer() As Byte, nEntries As Long, tPrinterList As PRINTER_INFO_2
    Dim PrinterName As String, PortName As String, DriverName As String
    Dim errorNum As Long, structsize As Long
    Dim i As Integer
    Dim temp As String
   
    structsize = LenB(tPrinterList)
   
    ReDim Buffer(BUFFER_INITIAL_SIZE)
   
    'Get printer list
    Success = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
                          PRINTER_ENUM_LOCAL, _
                          vbNullString, _
                          2, _
                          Buffer(0), _
                          BUFFER_INITIAL_SIZE, _
                          cbRequired, _
                          nEntries)
   
    If Not Success Then 'try again with larger buffer
        ReDim Buffer(cbRequired)
         Success = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
                      PRINTER_ENUM_LOCAL, _
                      vbNullString, _
                      2, _
                      Buffer(0), _
                      cbRequired, _
                      cbRequired, _
                      nEntries)
         errorNum = GetLastError
    End If
   
    If Success Then
        For i = 0 To nEntries - 1
            RtlMoveMemory tPrinterList, Buffer(i * structsize), structsize
            PrinterName = copyString(tPrinterList.pPrinterName)
            PortName = copyString(tPrinterList.pPortName)
            DriverName = copyString(tPrinterList.pDriverName)
            temp = temp & PrinterName & ";""" & PrinterName & "," & PortName & "," & DriverName & """;"
        Next
    Else 'second try failed too -- can't get list of printers
       temp = "Couldn't list printers - Error#: " & errorNum & ";;"
    End If
   
    CreatePrinterList = temp
   
End Function

Public Function setDefaultPrinter(profileString As String)

   WriteProfileString "windows", "device", profileString
   
   'Broadcast for 95
   SendMessageTimeout HWND_BROADCAST, WM_WININICHANGE, 0, "windows", SMTO_NORMAL, 1000, 0
   
   'Broadcast for NT
   SendMessageTimeout HWND_BROADCAST, WM_WININICHANGE, 0, vbNullString, SMTO_NORMAL, 1000, 0

End Function

Private Function copyString(pstrSource As Long) As String
    Dim temp As String, location As Integer
    Dim lng As Long
   
    temp = Space$(1024)
    lng = PtrToStr(temp, pstrSource)
    location = InStr(1, temp, Chr$(0))
    copyString = IIf(location > 0, Left$(temp, location - 1), "")
   
End Function
0
 
LVL 7

Expert Comment

by:Believer
Comment Utility
I had a *very* similar need in a recent application I delivered.  I dreaded addressing the issue because I knew it was going to be a "bear."  The solution is *way* too long to put here as it involves a *lot* of code.  If you are interested, I can e-mail you what I did.  Would also be willing to engage in e-mail conversations to get you through.  Or, if you care to research and adapt the code yourself, I stole 95% of it from the Access 97 Developer's Handbook.
0
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 
LVL 25

Expert Comment

by:clockwatcher
Comment Utility
Believer,

I have no idea why you posted as an answer what is clearly a comment.  I realize you're new to experts-exchange, but it's considered extremely bad practice to post something as an answer unless it's very clear cut.  Simply saying that you've done this before is not an answer to a question nor is telling the questioner that if he wants to research it he can check out the Access 97 Developer's Handbook.  Both statements are clearly comments.  If VBExpert finds your comment an acceptable answer to his specific question, he can accept the comment as an answer.  But proposing it outright as an answer is taken as an offense, especially in the Access category.

BTW, there is nothing wrong with the code I posted.  It's untested under NT, but works fine on 95.  If there is a problem with it under NT, let me know about it and I'll fix it.  As you can also see there's not a *lot* of code involved.
0
 
LVL 7

Expert Comment

by:Believer
Comment Utility
I find it hard not to be offended by your harsh reply, but I'll give you the benefit of the doubt, clockwatcher.  
1. I will sincerely look into reversing my "answer" to a question.
2. I didn't tell VBExpert to research it, only that it's where I got the answer.
3. I apologize for the "offense."
0
 
LVL 7

Expert Comment

by:Believer
Comment Utility
Believer changed the proposed answer to a comment
0
 

Author Comment

by:VBExpert
Comment Utility
Thank you both I will test it under NT right now.  As I mentioned before referencing the same Printers device object on 95 and NT provide completely different results so I am not right off optimistic.  95 returns the needed name under the printer.Port device to copy to a network printer.  NT unfortunately returns stuff like Ne00: and Ne01: under the printers.port and must reference instead the other properties to get the correct name for NT :(

I'll let ya know how it tests out.

0
 

Author Comment

by:VBExpert
Comment Utility
I tried it on NT and it works on NT as well as 95/98!  Wonderful code, but we must find a way to actually post it here for the rest of the folks though.  I tried just using the code and found that the properties on your listbox were also somewhat important because of how you formatted the two columns made it look much nicer.

Great work!
0
 

Author Comment

by:VBExpert
Comment Utility
here is the main Basic Code Module text

Option Compare Database
Option Explicit

Private Const PRINTER_ENUM_CONNECTIONS = &H4
Private Const PRINTER_ENUM_LOCAL = &H2
Private Const HWND_BROADCAST = &HFFFF&
Private Const WM_WININICHANGE = &H1A
Private Const SMTO_NORMAL = &H0

Private Type PRINTER_INFO_2
    pServerName As Long
    pPrinterName As Long
    pShareName As Long
    pPortName As Long
    pDriverName As Long
    pComment As Long
    pLocation As Long
    otherBytes(55) As Byte      'Not interested in the rest of the structure
End Type


Private Declare Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" _
   (ByVal flags As Long, ByVal name As String, _
   ByVal Level As Long, pPrinterEnum As Any, ByVal cdBuf As Long, _
   pcbNeeded As Long, pcReturned As Long) As Long
   
Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyA" _
   (ByVal RetVal As String, ByVal Ptr As Long) As Long
   
Private Declare Function GetLastError Lib "kernel32" () As Long

Private Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As String, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long


Public Function CreatePrinterList() As String

    'Returns printer list in two column Access combobox format
    'First column is printer name, second is profile string
   
    Const BUFFER_INITIAL_SIZE = 1024

    Dim Success As Boolean, cbRequired As Long
    Dim Buffer() As Byte, nEntries As Long, tPrinterList As PRINTER_INFO_2
    Dim PrinterName As String, PortName As String, DriverName As String
    Dim errorNum As Long, structsize As Long
    Dim i As Integer
    Dim temp As String
   
    structsize = LenB(tPrinterList)
   
    ReDim Buffer(BUFFER_INITIAL_SIZE)
   
    'Get printer list
    Success = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
                          PRINTER_ENUM_LOCAL, _
                          vbNullString, _
                          2, _
                          Buffer(0), _
                          BUFFER_INITIAL_SIZE, _
                          cbRequired, _
                          nEntries)
   
    If Not Success Then 'try again with larger buffer
        ReDim Buffer(cbRequired)
         Success = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
                      PRINTER_ENUM_LOCAL, _
                      vbNullString, _
                      2, _
                      Buffer(0), _
                      cbRequired, _
                      cbRequired, _
                      nEntries)
         errorNum = GetLastError
    End If
   
    If Success Then
        For i = 0 To nEntries - 1
            RtlMoveMemory tPrinterList, Buffer(i * structsize), structsize
            PrinterName = copyString(tPrinterList.pPrinterName)
            PortName = copyString(tPrinterList.pPortName)
            DriverName = copyString(tPrinterList.pDriverName)
            temp = temp & PrinterName & ";""" & PrinterName & "," & PortName & "," & DriverName & """;"
        Next
    Else 'second try failed too -- can't get list of printers
       temp = "Couldn't list printers - Error#: " & errorNum & ";;"
    End If
   
    CreatePrinterList = temp
   
End Function

Public Function setDefaultPrinter(profileString As String)

   WriteProfileString "windows", "device", profileString
   
   'Broadcast for 95
   SendMessageTimeout HWND_BROADCAST, WM_WININICHANGE, 0, "windows", SMTO_NORMAL, 1000, 0
   
   'Broadcast for NT
   SendMessageTimeout HWND_BROADCAST, WM_WININICHANGE, 0, vbNullString, SMTO_NORMAL, 1000, 0

End Function

Private Function copyString(pstrSource As Long) As String
    Dim temp As String, location As Integer
    Dim lng As Long
   
    temp = Space$(1024)
    lng = PtrToStr(temp, pstrSource)
    location = InStr(1, temp, Chr$(0))
    copyString = IIf(location > 0, Left$(temp, location - 1), "")
   
End Function


'here is the main form code text
Option Compare Database
Option Explicit

Private Sub cmdDefault_Click()
    If lstPrinters.Value <> "" Then
        setDefaultPrinter lstPrinters.Value
    End If
   
End Sub

Private Sub Form_Load()
    lstPrinters.RowSource = CreatePrinterList()
   
End Sub

'obviously you will need a listbox named lstprinters and a command button named cmddefault_click to call the setdefaultprinter code.

'Actually I prefered to add this to the click event on the listbox itself rather than having a separate button to set the default printer.

Best Regards!
VBExpert

0
 

Author Comment

by:VBExpert
Comment Utility
Oh yes the listbox is best as

width of
2"
and with column width of
2";0"
so the second column is not invisible
then it is set to show "Values"
and you would Bound column
2


0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

The first two articles in this short series — Using a Criteria Form to Filter Records (http://www.experts-exchange.com/A_6069.html) and Building a Custom Filter (http://www.experts-exchange.com/A_6070.html) — discuss in some detail how a form can be…
Experts-Exchange is a great place to come for help with solutions for your database issues, and many problems are resolved within minutes of being posted.  Others take a little more time and effort and often providing a sample database is very helpf…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now