VBA - Convert Excel Files to PDF

[unknownymous]

Hi Gurus,

Could you possibly help me build a codes for this one?

Basically, I have a folder with excel Files:

Folder Name: Data Sheets

The folder contains different sheets example:
1. Data 1.xls
2. Data 2.xlxs
3. Data 3.xls
4. Data 5.xlsx
..and so on

Is there any way, where I can convert each excel files into PDF? Also, can I have another code for merging the PDFs into one (consolidated)?

Any thoughts will be much appreciated.

 

[Yongle]

Your first request
- pdf given same file name as the original file
- problematic if folder contains .xls and .xlsx versions with same name
- amend both path strings (ending both with path separator "\")

Sub CreatePdf()
    Dim Extn As String, wb As Workbook, wbNext As String, pdfName As String
    Const wbPath = "C:\TestArea\A1\"
    Const pdfPath = "C:\TestArea\A2\"
    Extn = "*.xls*"
   
    wbNext = Dir(wbPath & Extn)
    Do While wbNext <> ""
        Set wb = Workbooks.Open(wbPath & wbNext)
        DoEvents
        pdfName = Left(wbNext, InStrRev(wbNext, ".") - 1) & ".pdf"
        wb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPath & pdfName
        wb.Close SaveChanges:=False
        DoEvents
        wbNext = Dir
    Loop
End Sub

If you cannot get it working post your amended code in full

 

[Yongle]

Also, can I have another code for merging the PDFs into one (consolidated)?

How many workbooks are there ? How big are they ?
- one possibility is to loop through all sheets in all workbooks combining them into one big workbook and converting that to PDF

 

[unknownymous]

How many workbooks are there ? How big are they ?
- one possibility is to loop through all sheets in all workbooks combining them into one big workbook and converting that to PDF

Thanks for the help. The initial code was helpful.

As for merging the PDFs, each file is around 300KB and varies from 25-50 files in a folder (one tab only). When merging the PDFs, it should be in order:

Example:
1. PDF
2. PDF
3. PDF
...and so on.

Thanks again!

 

[Yongle]

Amended procedure as requested

Sub CreatePdf()
    Application.ScreenUpdating = False
    Dim Extn As String, wbNext As String, pdfName As String, wbTEMP As Workbook, wb As Workbook
    Const wbPath = "C:\TestArea\A1\"
    Const pdfPath = "C:\TestArea\A2\"
    Extn = "*.xls*"
    Set wbTEMP = Workbooks.Add
    
    wbNext = Dir(wbPath & Extn)
    Do While wbNext <> ""
        'open next workbook allowing time to complete that event
            Set wb = Workbooks.Open(wbPath & wbNext)
            DoEvents
        'add first sheet sheet to temporary workbook
            wb.Sheets(1).Copy after:=wbTEMP.Sheets(wbTEMP.Sheets.Count)
            DoEvents
        'export individual workbook to PDF
            pdfName = Left(wbNext, InStrRev(wbNext, ".") - 1) & ".pdf"
            wb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPath & pdfName
            wb.Close SaveChanges:=False
            DoEvents
        wbNext = Dir
    Loop
        'export temporary workbook to pdf and close without saving
            Application.DisplayAlerts = False
            wbTEMP.Sheets(1).Delete
            Application.DisplayAlerts = True
            wbTEMP.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPath & "Merged " & Format(Now, "YY-MM-DD HHMM")
            wbTEMP.Close False
End Sub

 

[unknownymous]

Amended procedure as requested

Sub CreatePdf()
    Application.ScreenUpdating = False
    Dim Extn As String, wbNext As String, pdfName As String, wbTEMP As Workbook, wb As Workbook
    Const wbPath = "C:\TestArea\A1\"
    Const pdfPath = "C:\TestArea\A2\"
    Extn = "*.xls*"
    Set wbTEMP = Workbooks.Add
   
    wbNext = Dir(wbPath & Extn)
    Do While wbNext <> ""
        'open next workbook allowing time to complete that event
            Set wb = Workbooks.Open(wbPath & wbNext)
            DoEvents
        'add first sheet sheet to temporary workbook
            wb.Sheets(1).Copy after:=wbTEMP.Sheets(wbTEMP.Sheets.Count)
            DoEvents
        'export individual workbook to PDF
            pdfName = Left(wbNext, InStrRev(wbNext, ".") - 1) & ".pdf"
            wb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPath & pdfName
            wb.Close SaveChanges:=False
            DoEvents
        wbNext = Dir
    Loop
        'export temporary workbook to pdf and close without saving
            Application.DisplayAlerts = False
            wbTEMP.Sheets(1).Delete
            Application.DisplayAlerts = True
            wbTEMP.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPath & "Merged " & Format(Now, "YY-MM-DD HHMM")
            wbTEMP.Close False
End Sub

Thanks for the help. However, I received an error Run time 1004 - The name is already taken. Try a different one.

 

[Yongle]

Tell me what you want to happen

Perhaps guarantee unique name with something like this ...
pdfName = Left(wbNext, InStrRev(wbNext, ".") - 1) & Format(Now, "YY-MM-DD HHMM") & ".pdf"

or replace the file if it already exists

or stop the code with a meassage

or something else

 

[unknownymous]

Tell me what you want to happen

Perhaps guarantee unique name with something like this ...
pdfName = Left(wbNext, InStrRev(wbNext, ".") - 1) & Format(Now, "YY-MM-DD HHMM") & ".pdf"

or replace the file if it already exists

or stop the code with a meassage

or something else

I tried the code but I'm stilling getting the same error - pdfName = Left(wbNext, InStrRev(wbNext, ".") - 1) & Format(Now, "YY-MM-DD HHMM") & ".pdf"

I have the number below and noticed that after doing the first run, it skips number "2. " and work on "10. "

1. Name
2. Name
...
10.

Also, I'm unsure if the error has to do with the temp workbook...after Book 1 is closed the temp workbook is named as Book 2 and so on.

Any thoughts will be much appreciated.