Link to home
Start Free TrialLog in
Avatar of darls15
darls15

asked on

Error when running macro that merges and saves MSWord docs as PDFs

Hi Experts

I've found some very useful macro code which helps me to automatically merge and save individual PDFs documents.

I've associated the macro with a button in a MSWord document. It automatically opens my MSWord document (which is a certificate) that contains merge fields linking it to a MSAccess query and then creates individucal MSWord documents for each records and finally PDFs them in the same process.

Everything works as I would except it to and all PDFs get created, however I'm receiving this error at the end of the process, "This file is in use by another application or user."

Can anyone help with with why this happens? I have attached a text document with the code.

Thanks in advance
darls15
MergePDFsCode.txt
Avatar of GrahamSkan
GrahamSkan
Flag of United Kingdom of Great Britain and Northern Ireland image

I can't quarrel with the first macro. I recognise one of my own comments in it.

However the second one tries to open every file in the folder and create a PDF from it, even if it is already a PDF. The rename from .doc to .pdf won't do anything, so you will be trying to export to a file that is already open. This version filters out the files that aren't Word documents.
Sub ConvertWordsToPdfs()

    Dim strFolder As String
    Dim strFile As String
    Dim doc As Document
    Dim newName As String
    Dim strNameParts() As String
    
    
    strFolder = "G:\General\OUTPUT"
    strFile = Dir(strFolder & "\*.doc*") ' word document files only (.doc, .docx, .docm)
    Do Until strFile = ""
        strNameParts = Split(strFile, ".")
        strNameParts(UBound(strNameParts)) = "pdf" .set extension to pdf
        newName = Join(strNameParts, ".")
        Set doc = Documents.Open(strFolder & "\" & strFile)
        doc.ExportAsFixedFormat OutputFileName:=strFolder & "\" & newName, _
                ExportFormat:=wdExportFormatPDF
        doc.Close wdDoNotSaveChanges
        strFile = Dir
    Loop

End Sub

Open in new window

If you don't need to have Word document copies you can export in the first macro:
Sub MergeToPDFs()
    Dim wdMainDoc As Word.Document
    Dim r As Integer
    Dim rng As Word.Range
    Dim wdResultDoc As Document
    
    Set wdMainDoc = Documents.Open("G:\General\Certificates.docm")
    With wdMainDoc.MailMerge
        .MainDocumentType = wdFormLetters
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        .DataSource.ActiveRecord = wdFirstDataSourceRecord
        Do
            'Do the Mail Merge to new document
            With .DataSource
                .FirstRecord = .ActiveRecord
                .LastRecord = .ActiveRecord
            End With
            'Set the value from the merge data
            .Execute
            'Export the resulting document
            Set wdResultDoc = ActiveDocument
            wdResultDoc.ExportAsFixedFormat _
                OutputFileName:="G:\General\OUTPUT\" & .DataSource.DataFields("RegESW").Value & ".doc", _
                ExportFormat:=wdExportFormatPDF
            wdResultDoc.Close wdDoNotSaveChanges
            r = .DataSource.ActiveRecord
            .DataSource.ActiveRecord = wdNextDataSourceRecord
            'recordcount might not be findable (=-1),
            'so just check to see if we're stuck on the same record
        Loop Until r = .DataSource.ActiveRecord
    End With
    wdMainDoc.Close wdDoNotSaveChanges
End Sub

Open in new window

Avatar of darls15
darls15

ASKER

Hi Graham

First of all, thank you for the original macro, this is going to help me a lot!

I tried your amended ConvertWordsToPdfs macro and it works very well and all PDFs are created without error.

I then tried your second macro as I don't need to keep the copies of the Word documents however it only created the Word versions and stopped.

Can you please help?

Thanks
darls15
ASKER CERTIFIED SOLUTION
Avatar of GrahamSkan
GrahamSkan
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of darls15

ASKER

This is brilliant & works perfectly! Thanks for all your help Graham.

Have a great day.
darls15