word to pdf

[CooterBrown]

Hello All... I know this one has been beaten' to death. I've searched the forum and found posts that are helpful but not 100% what I need. I have the following existing code that prints a bunch of .docs to the default printer. I have Adobe Acrobat Pro 6.0 installed with the adobe printer set as default on my machine (this runs locally). I need to modify this code so that these docs can be converted/printed to PDF by passing a parameter to name the file (ie..not use save dialog box for each file.)
This is a Macro in Excel but I can create an executable in VB6.0 if I have to:



Sub getinfo()

Dim oFs As New FileSystemObject
Dim oFolder As Folder
Dim oFile As File

folderspec = "C:\Test\quikdocs"
If oFs.FolderExists(folderspec) Then
Set oFolder = oFs.GetFolder(folderspec)


Range("A2").Select
Do Until ActiveCell.Value = " " Or ActiveCell.Value = Empty

PolicyNumber = ActiveCell.Value
Call Addzeros(PolicyNumber, 9)

record = Trim(PolicyNumber)
Document = ActiveCell.Offset(0, 5)
Document = folderspec & "\" & Document
Call worddox(Document)


PolicyNumber = ""
record = ""
Document = ""


ActiveCell.Offset(1, 0).Select
Loop

End If
End Sub
Sub AddBlnks(line, Length)
Do Until Len(line) >= Length
line = line & " "
Loop
End Sub
Sub AddLeadingBlnks(line, Length)
Do Until Len(line) >= Length
line = " " & line
Loop
End Sub
Sub Addzeros(line, Length)
Do Until Len(line) >= Length
line = "0" & line
Loop
End Sub


Public Sub worddox(txthyperlink)
Dim pWordApp As Word.Application
Dim pWordDoc As Word.Document

Set pWordApp = New Word.Application

'On Error Resume Next
Set pWordDoc = pWordApp.Documents.Open(txthyperlink)
'On Error GoTo ERR_ALERT

If Not pWordDoc Is Nothing Then
pWordApp.Visible = False
pWordDoc.PrintOut
pWordDoc.Activate
pWordDoc.Close
Set pWordDoc = Nothing
End If
Exit Sub


ERR_ALERT:
Set pWordDoc = Nothing
End Sub

 

[Chance1234]

woudl it be something like

pWordDoc.PrintOut ActivePrinter:="Acrobat Distiller"

Chance,

Filmmaker, gentlemen and read my blog at

http://www.20six.co.uk/Chance1234

 

[CooterBrown]

When I installed Acrobat 6.0, a printer driver was installed called "Adobe PDF". I'm sure this isn't what you mean by "Adobe Distiller". I think it is actually a "PDF Converter". I have the distiller installed and I have it checked in the references but when I set it as the Active PRinter = "Acrobat Distiller", I get Method active printer of object Global failed. How do I set up the distiller as a printer? Is that the problem?

 

[Chance1234]

Do you have the adobe references set up in VBA ?
, its been a while admitedly since using adobe products, but im pretty sure its jsut a case of referencing it and then setting the activeprinter as above or with "PDF Converter"




Chance,

Filmmaker, gentlemen and read my blog at

http://www.20six.co.uk/Chance1234

 

[CooterBrown]

I guess, I'll just write these to a PostScript (.ps) file and use the distiller manually to convert them. However; the problem I get when I attempt to do that with the below pasted code is, after about 50 records or word docs, i get an issuffiecient memory or disk space error.

Any ideas on why that would be happening?

Thanks,
Coot



Sub getinfo()

Dim oFs As New FileSystemObject
Dim oFolder As Folder
Dim oFile As File

folderspec = "C:\Test\quikdocs"
If oFs.FolderExists(folderspec) Then
Set oFolder = oFs.GetFolder(folderspec)


Range("A2").Select
Do Until ActiveCell.Value = " " Or ActiveCell.Value = Empty

PolicyNumber = ActiveCell.Value
Call Addzeros(PolicyNumber, 9)

record = Trim(PolicyNumber) & "_.ps"
Document = ActiveCell.Offset(0, 5)
Document = folderspec & "\" & Document
filename = "C:\test\Postscripts\in\" & record
Call worddox(Document, filename)


PolicyNumber = ""
record = ""
Document = ""


ActiveCell.Offset(1, 0).Select
Loop

End If
End Sub
Sub AddBlnks(line, Length)
Do Until Len(line) >= Length
line = line & " "
Loop
End Sub
Sub AddLeadingBlnks(line, Length)
Do Until Len(line) >= Length
line = " " & line
Loop
End Sub
Sub Addzeros(line, Length)
Do Until Len(line) >= Length
line = "0" & line
Loop
End Sub


Public Sub worddox(txthyperlink, filename)
Dim pWordApp As Word.Application
Dim pWordDoc As Word.Document

Set pWordApp = New Word.Application

'On Error Resume Next
Set pWordDoc = pWordApp.Documents.Open(txthyperlink)
'On Error GoTo ERR_ALERT

If Not pWordDoc Is Nothing Then
pWordApp.Visible = False
pWordApp.PrintOut Range:=wdPrintAllDocument, OutputFilename:=filename, PrintToFile:=True, Collate:=True


pWordDoc.Activate
pWordDoc.Close
Set pWordDoc = Nothing
End If
Exit Sub


ERR_ALERT:
Set pWordDoc = Nothing
End Sub

 

[PHV]

You may add this before the Exit Sub:
pWordApp.Quit
Set pWordApp = Nothing

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[CooterBrown]

But it will give an error message if you attempt to quit before the printing is complete!

 

[PHV]

Add this parameter when calling the PrintOut method:
Background:=False,

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[Chance1234]

Cooterbrown, i will see if i got some example code left over from where i worked with adobe stuff before, will post back in the morning if i have

Chance,

Filmmaker, gentlemen and read my blog at

http://www.20six.co.uk/Chance1234

 

[CooterBrown]

That would be wonderful! Meanwhile, I'm going to keep plugging with what I've got and PHV's help.

Thanks to both of you!

BTW... Cool stuff with the 3D animation.

 

[Chance1234]

Still digging through, moment i find it i will post it

Chance,

Filmmaker, gentlemen and read my blog at

http://www.20six.co.uk/Chance1234

 

[Chance1234]

pWordDoc.PrintOut ActivePrinter:=""Acrobat PDFWriter"

try the above it should work.,

Chance,

Filmmaker, gentlemen and read my blog at

http://www.20six.co.uk/Chance1234