Solved

Can't build Simple Printer Select List in Access97?

Posted on 2000-02-28
13
306 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
ID: 2566673
0
 

Author Comment

by:VBExpert
ID: 2570219
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
ID: 2570244
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
Ransomware-A Revenue Bonanza for Service Providers

Ransomware – malware that gets on your customers’ computers, encrypts their data, and extorts a hefty ransom for the decryption keys – is a surging new threat.  The purpose of this eBook is to educate the reader about ransomware attacks.

 

Author Comment

by:VBExpert
ID: 2570762
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
ID: 2571522
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
ID: 2581731
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
 
LVL 25

Expert Comment

by:clockwatcher
ID: 2581776
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
ID: 2582097
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
ID: 2582103
Believer changed the proposed answer to a comment
0
 

Author Comment

by:VBExpert
ID: 2589498
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
ID: 2601154
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
ID: 2601174
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
ID: 2601190
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

Three Reasons Why Backup is Strategic

Backup is strategic to your business because your data is strategic to your business. Without backup, your business will fail. This white paper explains why it is vital for you to design and immediately execute a backup strategy to protect 100 percent of your data.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Reference theme colors in VBA 4 24
A Function to parse a text string 4 34
Exporting Access Tables as CSV 3 23
SQL multicriteria from ONE textbox 32 41
I see at least one EE question a week that pertains to using temporary tables in MS Access.  But surprisingly, I was unable to find a single article devoted solely to this topic. I don’t intend to describe all of the uses of temporary tables in t…
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
Familiarize people with the process of retrieving data from SQL Server using an Access pass-thru query. Microsoft Access is a very powerful client/server development tool. One of the ways that you can retrieve data from a SQL Server is by using a pa…
With Microsoft Access, learn how to specify relationships between tables and set various options on the relationship. Add the tables: Create the relationship: Decide if you’re going to set referential integrity: Decide if you want cascade upda…

786 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