Stampare da recordSet dei documenti di Word e salvarli in pdf

Question

si tratta di un lavoro "UnaTantum" pertanto mi basterebbe qualcosa di semplice e funzionale

ho un migliaio di file .docx e li devo stampare rinominandoli in .pdf 

Ho gia preparato una tabella con i campi:

AlNom ---> Percorso e Nome del file esistente  .docx

AlNewNom ----> Percorso e nome del nuovo file desiderato .pdf 

RecordSet eccetera dovrei essere a posto

Riesco ad aprire il file .docx e a richiuderlo

Quello che non riesco a fare quando il .docx è gia aperto è stamparlo

con la stampante predefinita pdf dandogli il nome sempre preso dal recordSet 

Private Sub txtAlNom_Click()

Dim DBx As DAO.Database

Set DBx = DBEngine(0)(0)

Dim RSx As DAO.Recordset

Set RSx = DBx.OpenRecordset("SELECT AlNom, AlNewNom FROM Alb;", dbOpenDynaset)

RSx.MoveFirst

Dim objAppl As Object

Dim objDocm As Object

    Do Until RSx.EOF

        Set objAppl = CreateObject("Word.Application")

        objAppl.Visible = True

        Set objDocm = objAppl.Documents.Open(RSx.Fields("AlNom").Value)

            ' qui vorrei stampare il documento Word Aperto

            ' con la stampante  pdf predefinita

            ' e dandogli come nome il valore del recordSet   

            '     RSx.Fields("AlNewNom").Value

        objAppl.Quit

    RSx.MoveNext

    Loop

RSx.Close

DBx.Close

Set RSx = Nothing

Set DBx = Nothing

End Sub

 Grazie per l'aiuto

Mancini

.

Answer 1

Ciao Mancini,

in considerazione del fatto che si tratta di un lavoro una-tantum e tenendo conto che la versione dei file di Word è sicuramente successiva alla 2003 (file .docx), potresti utilizzare il metodo ExportAsFixedFormat (introdotto a partire dalla versione 2007 di Office e inizialmente solo con l'aggiunta di un apposito plug-in). Prendendo a prestito un pezzetto del codice di Sandro (che saluto), potresti modificare la tua routine in questo modo (manca sempre una seppur minima gestione degli errori):

---

Private Sub txtAlNom_Click()

    Dim DBx As DAO.Database

    Dim RSx As DAO.Recordset

    Dim objAppl As Object

    Dim objDocm As Object

    Const wdExportFormatPDF As Integer = 17

    Set DBx = DBEngine(0)(0)

    Set RSx = DBx.OpenRecordset("SELECT AlNom, AlNewNom FROM Alb;", dbOpenSnapshot, dbReadOnly)

    Set objAppl = CreateObject("Word.Application")

    objAppl.Visible = True

    Do Until RSx.EOF

        Set objDocm = objAppl.Documents.Open(RSx.Fields("AlNom").Value)

            ' qui vorrei stampare il documento Word Aperto

            ' con la stampante  pdf predefinita

            ' e dandogli come nome il valore del recordSet

            '     RSx.Fields("AlNewNom").Value

        objDocm.ExportAsFixedFormat _

                OutputFileName:=RSx.Fields("AlNewNom").Value, _

                ExportFormat:=wdExportFormatPDF, _

                OpenAfterExport:=False

        objDocm.Close SaveChanges:=False

        RSx.MoveNext

    Loop

    objAppl.Quit

    On Error Resume Next

    RSx.Close

    DBx.Close

    Set RSx = Nothing

    Set DBx = Nothing

    Set objAppl = Nothing

    Set objDocm = Nothing

End Sub

---

Ho considerato che nel campo RSx.Fields("AlNewNom").Value sia inclusa l'estensione .pdf del file che andrai a creare. In caso contrario modifica di conseguenza la riga interessata.

David

Answer 2

ciao Mancini,

prova in   questo modo :

Option Compare Database

Option Explicit

#Const Dev = 0

#If Dev = 0 Then

    Private objAppl As Object

    Private objDocm As Object

 #Else

    Private objAppl As Word.Application

    Private objDocm As Word.Document

 #End If

Private Sub printPDF3()

On Error GoTo errHandler

If Not isWordRunnning Then Exit Sub

Dim DBx As DAO.Database

Set DBx = DBEngine(0)(0)

Dim RSx As DAO.Recordset

Set RSx = DBx.OpenRecordset("SELECT AlNom, AlNewNom FROM Alb;", dbOpenDynaset)

Const strImgFilePath As String = "C:\prova"   ' path di esportazione da personalizzare

RSx.MoveFirst

    Do Until RSx.EOF

         If FileExists(RSx.Fields("fullpath")) Then

            Set objDocm = objAppl.Documents.Open(RSx.Fields("fullpath").Value, 0)

            objDocm.ExportAsFixedFormat OutputFileName:=strImgFilePath & justFileName2(RSx.Fields("fullPath").Value) & ".pdf", _

                                     ExportFormat:=17, _

                                     OpenAfterExport:=False

                                     'wdExportFormatPDF=17

            objDocm.Close

        End If

     RSx.MoveNext

     Loop

exit_handler:

 RSx.Close

 DBx.Close

 objAppl.Quit

 Set objDocm = Nothing

 Set objAppl = Nothing

 Set RSx = Nothing

 Set DBx = Nothing

 VBA.MsgBox "ho finito", vbInformation, "avviso"

 Exit Sub

errHandler:

    With Err

        MsgBox "ERR#" & .Number _

             & vbNewLine & .Description _

             , vbOKOnly Or vbCritical

      End With

      Resume exit_handler

End Sub

Private Function isWordRunnning() As Boolean

    On Error Resume Next

    Set objAppl = GetObject(, "Word.Application")

    Err.Clear

    If objAppl Is Nothing Then

        Set objAppl = CreateObject("Word.Application")

        objAppl.Visible = False

    End If

    If Err <> 0 Then

        MsgBox "qualcosa non va...." & _

            Err.Description, vbCritical, "Warning"

        isWordRunnning = False

    Else

        isWordRunnning = True

    End If

End Function

Public Function justFileName2(ByVal strFullPath As String) As String

' questa funzione è realizzata da Mauro Gamberini [MVP EXCEL]

      Dim s() As String

      s = Split(strFullPath, "")

      justFileName2 = Left$(s(UBound(s)), InStrRev(s(UBound(s)), ".") - 1)

  End Function

Private Function FileExists(ByVal strPathFile As String) As Boolean

     On Error Resume Next

     FileExists = ((GetAttr(strPathFile) And vbDirectory) = 0)

 End Function

ciao, Sandro

Answer 3

Ciao Mancini,

in considerazione del fatto che si tratta di un lavoro una-tantum e tenendo conto che la versione dei file di Word è sicuramente successiva alla 2003 (file .docx), potresti utilizzare il metodo ExportAsFixedFormat (introdotto a partire dalla versione 2007 di Office e inizialmente solo con l'aggiunta di un apposito plug-in). Prendendo a prestito un pezzetto del codice di Sandro 

 Ottimo :)  proprio quello che mi mancava ....

Ti ringrazio molto,   e naturalmente anche Sandro che ci ha passato

l'idea di esportarlo direttamente in .pdf 

Grazie

Answer 4

Ciao Mancini,

per questi lavori ho spesso utilizzato PdfCreator, gratuito e con interfaccia COM pilotabile da codice.

Un esempio di codice (da provare) lo trovi al seguente link: Printing to PDFCreator using VBA

Ho modificato la routine in modo da parametrizzare path e nome del file pdf:

---

Sub PrintToPDF_Early(ByVal sPDFPath As String, ByVal sPDFName As String ) 

     'Author       : Ken Puls ([url]www.excelguru.ca[/url])

     'Macro Purpose: Print to PDF file using PDFCreator

     '   (Download from [url]http://sourceforge.net/projects/pdfcreator/[/url])

     '   Designed for early bind, set reference to PDFCreator

    Dim pdfjob As PDFCreator.clsPDFCreator 

     '/// Change the output file name here! ///

    sPDFName = "testPDF.pdf" 

    sPDFPath = ActiveDocument.Path & Application.PathSeparator 

    Set pdfjob = New PDFCreator.clsPDFCreator 

    With pdfjob 

        If .cStart("/NoProcessingAtStartup") = False Then 

            MsgBox "Can't initialize PDFCreator.", vbCritical + _ 

            vbOKOnly, "PrtPDFCreator" 

            Exit Sub 

        End If 

        .cOption("UseAutosave") = 1 

        .cOption("UseAutosaveDirectory") = 1 

        .cOption("AutosaveDirectory") = sPDFPath 

        .cOption("AutosaveFilename") = sPDFName 

        .cOption("AutosaveFormat") = 0 ' 0 = PDF

        .cClearCache 

    End With 

     'Print the document to PDF

    Application.ActivePrinter = "PDFCreator1" 

    ActiveDocument.PrintOut 

     'Wait until the print job has entered the print queue

    Do Until pdfjob.cCountOfPrintjobs = 1 

        DoEvents 

    Loop 

    pdfjob.cPrinterStop = False 

     'Wait until PDF creator is finished then release the objects

    Do Until pdfjob.cCountOfPrintjobs = 0 

        DoEvents 

    Loop 

    pdfjob.cClose 

    Set pdfjob = Nothing 

End Sub 

---

Richiede ovviamente l'installazione di pdfcreator e la referenziazione della libreria all'interno del tuo progetto VBA

Come detto non l'ho provata, a te l'onere :-)

David

Answer 5

Ciao,

forse potresti risolvere con una sequenza di SendKeys.

Mimmo