Solved

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

Posted on 2010-09-15
6
1,784 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 500 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 500 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
Office 365 Training for Admins - 7 Day Trial

Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies.  Only from Platform Scholar.

 

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 500 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

MS Dynamics Made Instantly Simpler

Make Your Microsoft Dynamics Investment Count  & Drastically Decrease Training Time by Providing Intuitive Step-By-Step WalkThru Tutorials.

Question has a verified solution.

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

The Windows Phone Theme Colours is a tight, powerful, and well balanced palette. This tiny Access application makes it a snap to select and pick a value. And it doubles as an intro to implementing WithEvents, one of Access' hidden gems.
This article describes how to import an Outlook PST file to Office 365 using a third party product to avoid Microsoft's Azure command line tool, saving you time.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…
Add bar graphs to Access queries using Unicode block characters. Graphs appear on every record in the color you want. Give life to numbers. Hopes this gives you ideas on visualizing your data in new ways ~ Create a calculated field in a query: …

729 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