macro to run series of reports to PDF

[Marc Bobrow]

I use the macro below with Hyperion Enterprise Retreive (an Excel add-in) to
run a series of reports and save them to PDF files. The macro works great
with my Win2000Pro machine running Excel 2000, but I've been upgraded to an
XP machine with Excel 2003. The macro gets stuck on the row:
Application.ActivePrinter = "Acrobat Distiller on Ne00:"
Any thoughts as to why?

Thanks,

Marc



Range("$K$1").Select
ActiveCell.FormulaR1C1 = "report1"
Range("$c$21").Select

Dim PSFileName As String
Application.ActivePrinter = "Acrobat Distiller on Ne00:"
Application.Goto Reference:="r1c1"
Let PSFileName = Application.ActiveCell
SendKeys PSFileName & "{ENTER}", False
ActiveSheet.PageSetup.PrintArea = "$G$1:$AM$83"
ActiveSheet.PrintOut , PrintToFile:=True
PSFileName = Chr(34) & PSFileName & Chr(34)

Range("$K$1").Select
ActiveCell.FormulaR1C1 = "report2"
Range("$c$21").Select

Application.ActivePrinter = "Acrobat Distiller on Ne00:"
Application.Goto Reference:="r1c1"
Let PSFileName = Application.ActiveCell
SendKeys PSFileName & "{ENTER}", False
ActiveSheet.PageSetup.PrintArea = "$G$1:$AM$83"
ActiveSheet.PrintOut , PrintToFile:=True
PSFileName = Chr(34) & PSFileName & Chr(34)

The macro continues on for a list of around 50 reports...

 

[Gary Brown]

Maybe the new configuration looks at the printer differently.
Run this...
Debug.Print Application.ActivePrinter
to check out what the syntax should be.
Don't know if this will solve your problem, however.
Good Luck and Hope this Helps,

 

[Marc Bobrow]

Thanks for this suggestion, Gary. I feel a little foolish, but I don't know
how to do what you are suggesting. Adding the script you suggested to my
existing macro did not work. What do I do to run this?

 

[Gary Brown]

OK, Let's try something slightly different. Create a small macro and run
it. A message box will appear telling you what the syntax is for your
current printer. To do this...

Select...
'TOOLS' then 'MACRO' then 'VISUAL BASIC EDITOR'

Select...
'INSERT MODULE'

Enter the following text...

Sub Test()
MsgBox Application.ActivePrinter
End Sub

Put your cursor on the line 'MsgBox Application.ActivePrinter'.
Press the 'F5' key or select...
'RUN' then 'RUN SUB/USER FORM'

A Message Box will appear with something like...
hp officejet 6100 series on Ne00:

Very similar to what you have...
Hopefully, it's slightly different and by making the 'correction', your
macro will work.

Good Luck.
Sincerely,

 

[Gary Brown]

I just thought of something else. You say you just got upgraded to a new
computer. Are you sure it has Acrobat Distiller on it?

 

[Gary Brown]

Marc,
I have a rather complicated macro that lists ALL your printers. Copy this
to a blank module (create it using the 'Insert Module' technique) and run the
'Printer_List' macro (part way down the page) by putting your cursor on the
line that says...

Sub Printer_List()

and Press the 'F5' key.
--
Gary Brown
(e-mail address removed)


'/ START COPYING HERE ---------------------------------------/

Const PRINTER_ENUM_CONNECTIONS = &H4
Const PRINTER_ENUM_LOCAL = &H2

Private Declare Function EnumPrinters _
Lib "winspool.drv" Alias "EnumPrintersA" _
(ByVal flags As Long, ByVal name As String, _
ByVal Level As Long, _
pPrinterEnum As Long, ByVal cdBuf As Long, _
pcbNeeded As Long, _
pcReturned As Long) As Long

Private Declare Function PtrToStr _
Lib "kernel32" Alias "lstrcpyA" _
(ByVal RetVal As String, _
ByVal Ptr As Long) As Long

Private Declare Function StrLen _
Lib "kernel32" Alias "lstrlenA" _
(ByVal Ptr As Long) As Long
'

'/=============================================/

Public Function ListPrinters() As Variant

Dim bSuccess As Boolean
Dim iBufferRequired As Long
Dim iBufferSize As Long
Dim iBuffer() As Long
Dim iEntries As Long
Dim iIndex As Long
Dim strPrinterName As String
Dim iDummy As Long
Dim iDriverBuffer() As Long
Dim strPrinters() As String

iBufferSize = 3072

ReDim iBuffer((iBufferSize \ 4) - 1) As Long

'EnumPrinters will return a value False if the
' buffer is not big enough
bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
PRINTER_ENUM_LOCAL, vbNullString, _
1, iBuffer(0), iBufferSize, _
iBufferRequired, iEntries)

If Not bSuccess Then
If iBufferRequired > iBufferSize Then
iBufferSize = iBufferRequired
Debug.Print _
"iBuffer too small. Trying again with "; _
iBufferSize & " bytes."
ReDim iBuffer(iBufferSize \ 4) As Long
End If
'Try again with new buffer
bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
PRINTER_ENUM_LOCAL, vbNullString, _
1, iBuffer(0), iBufferSize, iBufferRequired, iEntries)
End If

If Not bSuccess Then
'Enumprinters returned False
MsgBox "Error enumerating printers."
Exit Function
Else
'Enumprinters returned True,
' use found printers to fill the array
ReDim strPrinters(iEntries - 1)
For iIndex = 0 To iEntries - 1
'Get the printername
strPrinterName = Space$(StrLen(iBuffer(iIndex * 4 + 2)))
iDummy = PtrToStr(strPrinterName, iBuffer(iIndex * 4 + 2))
strPrinters(iIndex) = strPrinterName
Next iIndex
End If

ListPrinters = strPrinters

End Function
'/===============================================/


'You could call the function as follows:

'/============================================/
Sub Printer_List()

Dim x As Long, i As Long
Dim strPrinterList As String
Dim strAnswer As String, strAnswer1 As String
Dim strAnswer2 As String, strAnswer3 As String
Dim varPrinters As Variant

strAnswer1 = "Show in Message Box"
strAnswer2 = "Put on Worksheet at current location"
strAnswer3 = "Cancel"

strAnswer = _
Wksht_or_Msgbox(strAnswer1, strAnswer2, strAnswer3)

If strAnswer = strAnswer3 Then
Exit Sub
End If

varPrinters = ListPrinters
strPrinterList = ""
'Fist check whether the array is filled with anything,
' by calling another function, IsBounded.

Select Case strAnswer
Case strAnswer1
If IsBounded(varPrinters) Then
strPrinterList = "Available Printers: "
For x = LBound(varPrinters) To UBound(varPrinters)
strPrinterList = _
strPrinterList & vbCr & varPrinters(x)
Next x
strPrinterList = strPrinterList & vbCr & vbCr & _
"Active Printer: " & Application.ActivePrinter
Else
strPrinterList = _
strPrinterList & vbCr & "No printers found"
End If
MsgBox strPrinterList

Case strAnswer2
ActiveCell.value = "Available Printers: "
If IsBounded(varPrinters) Then
For x = LBound(varPrinters) To UBound(varPrinters)
i = i + 1
ActiveCell.Offset(i, 0).value = varPrinters(x)
Next x
ActiveCell.Offset(i + 2, 0).value = _
"Active Printer: " & Application.ActivePrinter
Else
ActiveCell.value = "No printers found"
End If

Case strAnswer3
Exit Sub
Case Else
Exit Sub

End Select

End Sub

'/==============================================/
Public Function IsBounded(vArray As Variant) As Boolean

'If the variant passed to this function is an array,
' the function will return True;
' otherwise it will return False
On Error Resume Next
IsBounded = IsNumeric(UBound(vArray))

End Function
'/==================================================/
Function Wksht_or_Msgbox(str1, str2, str3) As String
'Adds choices as defined in Ops array below
Dim aryChoices()
Dim iMaxChoices As Double
Dim strTitle As String
Dim varChoiceSelected As Variant

iMaxChoices = 3
strTitle = "Printer List Output..."

ReDim aryChoices(1 To iMaxChoices)

aryChoices(1) = str1
aryChoices(2) = str2
aryChoices(3) = str3

'Array of choices, default choice, title of form
varChoiceSelected = GetChoice(aryChoices, 1, strTitle)
' MsgBox aryChoices(varChoiceSelected)
Wksht_or_Msgbox = aryChoices(varChoiceSelected)
End Function

'/===END COPYING HERE============================/