Celebrate National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Access or Excel 2003:  Run time error 1004 - 'Method Active Printer' of object failed

Posted on 2010-09-15
6
Medium Priority
?
1,835 Views
Last Modified: 2012-05-10
Hi EE,

In a post that i wrote in Feb 2010, i described that vba that referred to a printer on my pc, did not work when
running on a colleague's pc, bec. their ADOBE PDF printer had a different name.

(I don't know why our shop uses printers with "extended names"  such as Adobe PDF on Ne09 instead of just
Adobe PDF).

Am returning to the ideas that EE experts provided:

The vba lives in an mdb, yet i can have it run 2 ways:
           - automated via Windows scheduler
                     place call of mdb in bat file
           - from an Access menu screen

i have an idea:
         if the vba encounters an error on the hardcode Adobe printer name
              then handle the error, by displaying the printer dialog box

and so, i forced the error, by removing the "on ne09" and just left code to use hardcoded: "Adobe PDF"
       below is a screen shot that shows the error

then, i put error handlling logic to the sub, and put a debug.print for err.number   and err. description

unfortunately, the error.description, is very general:
     1004         Application-defined or object-defined error

and so, can i really test that 1004 is for a printer that's not found?

Your ideas would be very appreciated, tx, sandra

Public Sub f005_CopyFromRecordSet(strSql As String, _
                                  strCPath As String, _
                                  strExcelFile As String, _
                                  strBackRevisedExcelFile As String, _
                                  strBackPDFFile As String, _
                                  strBackPrintTestPage As String, _
                                  strBackStartYear As String, _
                                  strBackEndYear As String)


On Error GoTo Err_f005_CopyFromRecordSet

Dim strExcelPath          As String
Dim strPSfile             As String
Dim strLOGfile            As String


Dim lngPos                As Long
Dim lngResult             As Long
Dim lngLastRow            As Long

Dim db                    As DAO.Database
Dim rst                   As DAO.Recordset
Dim fld                   As DAO.Field


strExcelPath = CurrentProject.Path & "\" & strExcelFile
strBackRevisedExcelFile = CurrentProject.Path & "\" & Mid(strExcelFile, 7)

Call e090_LaunchExcel
' Set objExcel = CreateObject("Excel.Application")
  
Set objExcelActiveWkbs = objExcel.Workbooks

Set objExcelActiveWkb = objExcelActiveWkbs.Open(FileName:=strExcelPath)
Set objExcelActiveWS = objExcel.ActiveSheet

objExcel.Visible = True

Set db = CurrentDb
Set rst = db.OpenRecordset(strSql)

Debug.Print strSql

objExcelActiveWS.Range("A2").CopyFromRecordset rst


With objExcelActiveWS
     lngLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
     Set objExcelRange = .UsedRange


     With objExcelRange
          .EntireColumn.AutoFit
          
' for a format routine http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_23651624.html?sfQueryTermInfo=1+border+xldiagonaldown
' http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_24416104.html?sfQueryTermInfo=1+border+xldiagonaldown

          With .Borders(xlEdgeLeft)
               .LineStyle = xlContinuous
               .Weight = xlThin
               .ColorIndex = xlAutomatic
          End With
         
          With .Borders(xlEdgeTop)
               .LineStyle = xlContinuous
               .Weight = xlThin
               .ColorIndex = xlAutomatic
          End With
    
          With .Borders(xlEdgeBottom)
               .LineStyle = xlContinuous
               .Weight = xlThin
               .ColorIndex = xlAutomatic
          End With
    
          With .Borders(xlEdgeRight)
              .LineStyle = xlContinuous
              .Weight = xlThin
              .ColorIndex = xlAutomatic
          End With
    
         With .Borders(xlInsideVertical)
              .LineStyle = xlContinuous
              .Weight = xlThin
              .ColorIndex = xlAutomatic
         End With
    
         With .Borders(xlInsideHorizontal)
              .LineStyle = xlContinuous
              .Weight = xlThin
              .ColorIndex = xlAutomatic
         End With
              
     End With
         
     
     With .Columns("E:E")
          .NumberFormat = "mm/dd/yy;@"
     End With

     With .Columns("F:F")
          .NumberFormat = "mm/dd/yy;@"
     End With
    
    
    
End With

With objExcelActiveWS.PageSetup
        .LeftHeader = "page: &P of &N"
        
        .CenterHeader = "COLLEGE OF MEDICINE" & Chr(10) & _
                        strBackStartYear & _
                        "-" & _
                        strBackEndYear & Chr(10) & _
                        "COURSES LISTING"
                        
        .RightHeader = "As of: &D"
End With


objExcel.DisplayAlerts = False


' save Excel file
objExcelActiveWkb.SaveAs FileName:= _
     strBackRevisedExcelFile, _
     FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
     ReadOnlyRecommended:=False, CreateBackup:=False

'save default printer

pg_strDefaultPrinter = objExcel.ActivePrinter


' print excel file to Diane's printer
' http://www.pcreview.co.uk/forums/thread-950750.php

Debug.Print objExcel.ActivePrinter

' if print test page or entire excel
Dim lngFromPage As Long
Dim lngToPage   As Long

If strBackPrintTestPage = "D" Then
   'skip printout - go to export to pdf
   
Else
     objExcel.ActivePrinter = "Diane's Printer on Ne07:"
   ' objExcel.ActivePrinter = "Anne's printer on Ne06:"

     If strBackPrintTestPage = "Y" Then
        lngFromPage = 1
        lngToPage = 1
        objExcel.ActiveSheet.PrintOut From:=lngFromPage, To:=lngToPage
     Else
       objExcel.ActiveSheet.PrintOut
       objExcel.ActiveSheet.PrintOut
     End If
End If

' Create PS, LOG, PDF file names from Excel file name
lngPos = InStr(strBackRevisedExcelFile, ".")
strPSfile = Left(strBackRevisedExcelFile, lngPos) & "ps"
strLOGfile = Left(strBackRevisedExcelFile, lngPos) & "log"
strBackPDFFile = Left(strBackRevisedExcelFile, lngPos) & "pdf"

Debug.Print strPSfile
Debug.Print strLOGfile
Debug.Print strBackPDFFile

' objExcel.ActivePrinter = "CutePDF Writer on CPW2:"
  

Dim x As String
'objExcel.ActivePrinter = "Adobe PDF on Ne09:"
objExcel.ActivePrinter = "Adobe PDF"

' print Excel file to Acrobat PS file
Dim objPDF_Distiller As PdfDistiller
Set objPDF_Distiller = New PdfDistiller
  
' print is really an export to pdf
objExcel.ActiveSheet.PrintOut , Copies:=1, _
PrintToFile:=True, PrToFilename:=strPSfile
 
' Convert Acrobat PS file to PDF file
lngResult = objPDF_Distiller.FileToPDF(strPSfile, strBackPDFFile, "")

' delete work files
Kill strPSfile
Kill strLOGfile

Set objPDF_Distiller = Nothing
                                  
'Restore the default settings
objExcel.ActivePrinter = pg_strDefaultPrinter

objExcel.DisplayAlerts = True

Call e110_CloseExcel(True)

Set objExcel = Nothing
Set objExcelActiveWkb = Nothing
Set objExcelActiveWkbs = Nothing
Set objExcelActiveWS = Nothing
Set objExcelRange = Nothing

rst.Close
db.Close

Set rst = Nothing
Set db = Nothing
Set fld = Nothing


Err_f005_Exit:

   Exit Sub

Err_f005_CopyFromRecordSet:

    Debug.Print Err.Number, Err.Description

End Sub

Open in new window

2010-09-15-printer-error.GIF
0
Comment
Question by:mytfein
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 3
6 Comments
 
LVL 9

Accepted Solution

by:
hitsdoshi1 earned 2000 total points
ID: 33686334
Can't you just open the printer selection box and allow user to choose printer ?

Application.Dialogs(xlDialogPrinterSetup).Show
0
 

Author Comment

by:mytfein
ID: 33686403
Hi hitsdoshi1,

tx for writing...

i want to use the same mdb to have it run "like a script" on my machine with the Adobe Printer name
set to my pc's Adobe Pdf on Ne09. The script runs on my pc, unattended.... so do not want a dialogue
box to be evoked always...

and to be able to have the mdb run, if the user executes it from a menu (when i am out of the office)
since the user might have a diff. Adobe PDF setting, then the dialogue would pop up....

below i added more to the code, pls see error handler which incorporates your idea, and where i
want the printer dialogue to display only when there is a printer not found error:

tx, s
Public Sub f005_CopyFromRecordSet(strSql As String, _
                                  strCPath As String, _
                                  strExcelFile As String, _
                                  strBackRevisedExcelFile As String, _
                                  strBackPDFFile As String, _
                                  strBackPrintTestPage As String, _
                                  strBackStartYear As String, _
                                  strBackEndYear As String)


On Error GoTo Err_f005_CopyFromRecordSet

Dim strExcelPath          As String
Dim strPSfile             As String
Dim strLOGfile            As String


Dim lngPos                As Long
Dim lngResult             As Long
Dim lngLastRow            As Long

Dim db                    As DAO.Database
Dim rst                   As DAO.Recordset
Dim fld                   As DAO.Field


strExcelPath = CurrentProject.Path & "\" & strExcelFile
strBackRevisedExcelFile = CurrentProject.Path & "\" & Mid(strExcelFile, 7)

Call e090_LaunchExcel
' Set objExcel = CreateObject("Excel.Application")
  
Set objExcelActiveWkbs = objExcel.Workbooks

Set objExcelActiveWkb = objExcelActiveWkbs.Open(FileName:=strExcelPath)
Set objExcelActiveWS = objExcel.ActiveSheet

objExcel.Visible = True

Set db = CurrentDb
Set rst = db.OpenRecordset(strSql)

Debug.Print strSql

objExcelActiveWS.Range("A2").CopyFromRecordset rst


With objExcelActiveWS
     lngLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
     Set objExcelRange = .UsedRange


     With objExcelRange
          .EntireColumn.AutoFit
          
' for a format routine http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_23651624.html?sfQueryTermInfo=1+border+xldiagonaldown
' http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_24416104.html?sfQueryTermInfo=1+border+xldiagonaldown

          With .Borders(xlEdgeLeft)
               .LineStyle = xlContinuous
               .Weight = xlThin
               .ColorIndex = xlAutomatic
          End With
         
          With .Borders(xlEdgeTop)
               .LineStyle = xlContinuous
               .Weight = xlThin
               .ColorIndex = xlAutomatic
          End With
    
          With .Borders(xlEdgeBottom)
               .LineStyle = xlContinuous
               .Weight = xlThin
               .ColorIndex = xlAutomatic
          End With
    
          With .Borders(xlEdgeRight)
              .LineStyle = xlContinuous
              .Weight = xlThin
              .ColorIndex = xlAutomatic
          End With
    
         With .Borders(xlInsideVertical)
              .LineStyle = xlContinuous
              .Weight = xlThin
              .ColorIndex = xlAutomatic
         End With
    
         With .Borders(xlInsideHorizontal)
              .LineStyle = xlContinuous
              .Weight = xlThin
              .ColorIndex = xlAutomatic
         End With
              
     End With
         
     
     With .Columns("E:E")
          .NumberFormat = "mm/dd/yy;@"
     End With

     With .Columns("F:F")
          .NumberFormat = "mm/dd/yy;@"
     End With
    
    
    
End With

With objExcelActiveWS.PageSetup
        .LeftHeader = "page: &P of &N"
        
        .CenterHeader = "COLLEGE OF MEDICINE" & Chr(10) & _
                        strBackStartYear & _
                        "-" & _
                        strBackEndYear & Chr(10) & _
                        "COURSES LISTING"
                        
        .RightHeader = "As of: &D"
End With


objExcel.DisplayAlerts = False


' save Excel file
objExcelActiveWkb.SaveAs FileName:= _
     strBackRevisedExcelFile, _
     FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
     ReadOnlyRecommended:=False, CreateBackup:=False

'save default printer

pg_strDefaultPrinter = objExcel.ActivePrinter


' print excel file to Diane's printer
' http://www.pcreview.co.uk/forums/thread-950750.php

Debug.Print objExcel.ActivePrinter

' if print test page or entire excel
Dim lngFromPage As Long
Dim lngToPage   As Long

If strBackPrintTestPage = "D" Then
   'skip printout - go to export to pdf
   
Else
     objExcel.ActivePrinter = "Diane's Printer on Ne07:"
   ' objExcel.ActivePrinter = "Anne's printer on Ne06:"

     If strBackPrintTestPage = "Y" Then
        lngFromPage = 1
        lngToPage = 1
        objExcel.ActiveSheet.PrintOut From:=lngFromPage, To:=lngToPage
     Else
       objExcel.ActiveSheet.PrintOut
       objExcel.ActiveSheet.PrintOut
     End If
End If

' Create PS, LOG, PDF file names from Excel file name
lngPos = InStr(strBackRevisedExcelFile, ".")
strPSfile = Left(strBackRevisedExcelFile, lngPos) & "ps"
strLOGfile = Left(strBackRevisedExcelFile, lngPos) & "log"
strBackPDFFile = Left(strBackRevisedExcelFile, lngPos) & "pdf"

Debug.Print strPSfile
Debug.Print strLOGfile
Debug.Print strBackPDFFile

' objExcel.ActivePrinter = "CutePDF Writer on CPW2:"
  

Dim x As String
'=========================
' save as pdf file if Adobe is on the pc
'=========================
If IsAdobeInstalled = True Then
        
        'objExcel.ActivePrinter = "Adobe PDF on Ne09:"
        objExcel.ActivePrinter = "Adobe PDF"
        
        ' print Excel file to Acrobat PS file
        Dim objPDF_Distiller As PdfDistiller
        Set objPDF_Distiller = New PdfDistiller
        
        Debug.Print objExcel.ActivePrinter
          
        ' print is really an export to pdf
        objExcel.ActiveSheet.PrintOut , Copies:=1, _
        PrintToFile:=True, PrToFilename:=strPSfile
         
        ' Convert Acrobat PS file to PDF file
        lngResult = objPDF_Distiller.FileToPDF(strPSfile, strBackPDFFile, "")
        
        ' delete work files
        Kill strPSfile
        Kill strLOGfile
        
        Set objPDF_Distiller = Nothing
                                          
        'Restore the default settings
        objExcel.ActivePrinter = pg_strDefaultPrinter
        
        objExcel.DisplayAlerts = True
        
End If

Call e110_CloseExcel(True)

Set objExcel = Nothing
Set objExcelActiveWkb = Nothing
Set objExcelActiveWkbs = Nothing
Set objExcelActiveWS = Nothing
Set objExcelRange = Nothing

rst.Close
db.Close

Set rst = Nothing
Set db = Nothing
Set fld = Nothing


Err_f005_Exit:

   Exit Sub

Err_f005_CopyFromRecordSet:

    Debug.Print Err.Number, Err.Description
    
    Dim strActivePrinter As String
    Dim intResult        As Integer
 
    intResult = 0
 
    Do Until intResult > 0
       MsgBox "Please choose Adobe Printer from Printer Dialogue Box"
     
       objExcel.Dialogs(xlDialogPrinterSetup).Show
       strActivePrinter = objExcel.ActivePrinter
        
       intResult = InStr(1, strActivePrinter, "adobe", 1)
      
    Loop
    
    Resume Next
    

End Sub



Public Function IsAdobeInstalled() As Boolean
Dim strTemp As String

IsAdobeInstalled = False

strTemp = dir("C:\Program Files\Adobe\acrobat*", vbDirectory)

Do Until strTemp = ""
   IsAdobeInstalled = True
   strTemp = dir()
Loop

End Function

Open in new window

0
 
LVL 9

Assisted Solution

by:hitsdoshi1
hitsdoshi1 earned 2000 total points
ID: 33686441
I see.......I found this code few months ago....may be you can give it a shot....

Function NetworkPrinter(ByVal myprinter As String)
  On Error Resume Next
  Dim NetWork As Variant
  Dim X As Integer
  '/// Define NetWork Array \\\
  NetWork = Array("Ne00:", "Ne01:", "Ne02:", "Ne03:", "Ne04:", _
                   "Ne05:", "Ne06:", "Ne07:", "Ne08:", _
                   "Ne09:", "Ne10:", "Ne11:", "Ne12:", _
                   "Ne13:", "Ne14:", "Ne15:", "Ne16:", _
                   "LPT1:", "LPT2:", "File:", "SMC100:")
  'Setup printer to Print
  X = 0
TryAgain:
  On Error Resume Next
  'Printer
  Application.ActivePrinter = myprinter & Prt_On & NetWork(X)
  If Err.Number <> 0 And X < 16 Then
    X = X + 1
    GoTo TryAgain
  ElseIf Err.Number <> 0 And X > 15 Then
    GoTo PrtError
  End If
  On Error GoTo 0
  NetworkPrinter = myprinter & Prt_On & NetWork(X)
errorExit:
  Exit Function
PrtError:
  'no printer found
  NetworkPrinter = ""
  Resume errorExit
End Function
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:mytfein
ID: 33686476
Hi hitsdoshi1,

tx... ok i skimmed the code, overall i understand it....

do you know what this line does/means?

On Error GoTo 0   (does it mean to ignore errors and continue to next sentence?)

tx, s
0
 
LVL 9

Assisted Solution

by:hitsdoshi1
hitsdoshi1 earned 2000 total points
ID: 33686491
http://msdn.microsoft.com/en-us/library/5hsw66as%28VS.80%29.aspx

GoTo 0

    Disables enabled error handler in the current procedure and resets it to Nothing.
0
 

Author Comment

by:mytfein
ID: 33686501
Thanks hitsdoshi1 for your help....

If i have any questions, will write a related post tommorrow...

tx again, s
0

Featured Post

Free learning courses: Active Directory Deep Dive

Get a firm grasp on your IT environment when you learn Active Directory best practices with Veeam! Watch all, or choose any amount, of this three-part webinar series to improve your skills. From the basics to virtualization and backup, we got you covered.

Question has a verified solution.

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

I was prompted to write this article after the recent World-Wide Ransomware outbreak. For years now, System Administrators around the world have used the excuse of "Waiting a Bit" before applying Security Patch Updates. This type of reasoning to me …
If you need a simple but flexible process for maintaining an audit trail of who created, edited, or deleted data from a table, or multiple tables, and you can do all of your work from within a form, this simple Audit Log will work for you.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…

730 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