Solved

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

Posted on 2010-09-15
6
1,709 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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
In a multiple monitor setup, if you don't want to use AutoCenter to position your popup forms, you have a problem: where will they appear?  Sometimes you may have an additional problem: where the devil did they go?  If you last had a popup form open…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

706 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

18 Experts available now in Live!

Get 1:1 Help Now