Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1867
  • Last Modified:

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

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
mytfein
Asked:
mytfein
  • 3
  • 3
3 Solutions
 
hitsdoshi1Commented:
Can't you just open the printer selection box and allow user to choose printer ?

Application.Dialogs(xlDialogPrinterSetup).Show
0
 
mytfeinAuthor Commented:
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
 
hitsdoshi1Commented:
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
NEW Veeam Agent for Microsoft Windows

Backup and recover physical and cloud-based servers and workstations, as well as endpoint devices that belong to remote users. Avoid downtime and data loss quickly and easily for Windows-based physical or public cloud-based workloads!

 
mytfeinAuthor Commented:
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
 
hitsdoshi1Commented:
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
 
mytfeinAuthor Commented:
Thanks hitsdoshi1 for your help....

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

tx again, s
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 3
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now