Solved

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

Posted on 2010-09-15
6
1,738 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
  • 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
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: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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

This article will show you how to use shortcut menus in the Access run-time environment.
Recently Microsoft released a brand new function called CONCAT. It's supposed to replace its predecessor CONCATENATE. But how does it work? And what's new? In this article, we take a closer look at all of this - we even included an exercise file for…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

943 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

9 Experts available now in Live!

Get 1:1 Help Now