HELP !! VBA Folders & PDF

Manchesterisred

New Member
Joined
Aug 20, 2021
Messages
17
Office Version
  1. 365
Platform
  1. Windows
Hello Everyone, I need your help on my Excel macro.

I have an excel file with 20 worksheets. I need the worksheets Individually converted to PDF and then saved in their own folder within a master folder. This is the macro i have so far - its basically been put together from previous macros i have used.

At the moment when i run it, it creates a new folder which is perfect but then it saves the PDF's outside of the folder.

I need the PDF's to be saved in their individual folders ( names the same as the worksheet and also a cell range name, inside of the main the master folder.

Can anyone suggest any ideas ??




Sub DD Letters()
'
' Direct debit Letters convert excel to PDF and save to drive
'
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim sh As Worksheet
Dim DateString As String
Dim FolderName As String

With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationAutomatic
End With

'Copy every sheet from the workbook with this macro
Set Sourcewb = ThisWorkbook

'Create new folder to save the new files in
DateString = Format(Now, "yyyy-mm-dd")
FolderName = Sourcewb.Path & "\" & "Direct Debit Letters dated - " & Format(Sourcewb.Worksheets("DD").Range("C32"), "dd.mm.yyyy")
MkDir FolderName

'Loop through all worksheets and save as individual PDF in same folder as the Excel file
For Each ws In ActiveWorkbook.Worksheets

ws.ExportAsFixedFormat Type:=xlTypePDF, _
FileName:=ThisWorkbook.Path & "/" & ws.Name & ".pdf"
FolderName = Path & "/" & ws.Name & ".pdf"

Next
'
End Sub
 

rlv01

Well-known Member
Joined
May 16, 2017
Messages
1,160
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
You cannot combine ranges in that way.

Bad:
VBA Code:
WS.Range("B22" & "E20").Value

Good:
VBA Code:
WS.Range("B22").Value & WS.Range("E20").Value

So the modified line might look like this:

VBA Code:
CellData = Trim(CStr(WS.Range("B22").Value & WS.Range("E20").Value))

Reminder: Please try to use code tags when you post code.
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.

Manchesterisred

New Member
Joined
Aug 20, 2021
Messages
17
Office Version
  1. 365
Platform
  1. Windows
You cannot combine ranges in that way.

Bad:
VBA Code:
WS.Range("B22" & "E20").Value

Good:
VBA Code:
WS.Range("B22").Value & WS.Range("E20").Value

So the modified line might look like this:

VBA Code:
CellData = Trim(CStr(WS.Range("B22").Value & WS.Range("E20").Value))

Reminder: Please try to use code tags when you post code.

Thanks Riv - I updated the macro but it gives me a debug on MkDir Path highlighted below. Everything else is as per you wrote


Sub DDPDF()
'
' Direct debit Letters convert excel to PDF and save to drive
'
Dim Sourcewb As Workbook
Dim ws As Worksheet
Dim DateString As String
Dim FolderName As String, Path As String, FName As String
Dim CellData As String

With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationAutomatic
End With

'Copy every sheet from the workbook with this macro
Set Sourcewb = ThisWorkbook

'Create new MASTER folder to save the new files in
DateString = Format(Now, "yyyy-mm-dd")
FolderName = Sourcewb.Path & "\" & "Direct Debit Letters dated - " & Format(Sourcewb.Worksheets("DD").Range("C32"), "dd.mm.yyyy")
MkDir FolderName

'Loop through all worksheets and save as individual PDF in same folder as the Excel file
For Each ws In ActiveWorkbook.Worksheets
Select Case ws.Name
Case "Instructions", "DDsap", "DD", "DDclean", "Company", "Summary", "EUR", "GBP", "USD" 'This is the worksheet ignore list. Edit as needed
Case Else
CellData = Trim(CStr(ws.Range("B22").Value & ws.Range("E20").Value)) 'Cell data to use in names. Must not contain illegal chars.

'Create new INDIVIDUAL file folder to save the new file in
Path = FolderName & "\" & ws.Name & " - " & CellData
MkDir Path

FName = Path & "\" & ws.Name & " - " & CellData & ".pdf"

ws.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FName
End Select
Next ws

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
 

rlv01

Well-known Member
Joined
May 16, 2017
Messages
1,160
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
I posted a link to the forum section titled "How to Post Your VBA Code". It does not appear blank to me.
 

Manchesterisred

New Member
Joined
Aug 20, 2021
Messages
17
Office Version
  1. 365
Platform
  1. Windows
I posted a link to the forum section titled "How to Post Your VBA Code". It does not appear blank to me.

Hi Riv, apologises i am a novice at VBA and my understanding is not as great as yours. Would you be so kind as to just check my insertion below in bold to see if its correct ? If not, can you kindly make the correction.

Thank you


Sub DDPDF()
'
' Direct debit Letters convert excel to PDF and save to drive
'
Dim Sourcewb As Workbook
Dim ws As Worksheet
Dim DateString As String
Dim FolderName As String, Path As String, FName As String
Dim CellData As String

With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationAutomatic
End With

'Copy every sheet from the workbook with this macro
Set Sourcewb = ThisWorkbook

'Create new MASTER folder to save the new files in
DateString = Format(Now, "yyyy-mm-dd")
FolderName = Sourcewb.Path & "\" & "Direct Debit Letters dated - " & Format(Sourcewb.Worksheets("DD").Range("C32"), "dd.mm.yyyy")
MkDir FolderName

'Loop through all worksheets and save as individual PDF in same folder as the Excel file
For Each ws In ActiveWorkbook.Worksheets
Select Case ws.Name
Case "Instructions", "DDsap", "DD", "DDclean", "Company", "Summary", "EUR", "GBP", "USD" 'This is the worksheet ignore list. Edit as needed
Case Else
CellData = Trim(CStr(ws.Range("B22").Value & ws.Range("E20").Value)) 'Cell data to use in names. Must not contain illegal chars.

'Create new INDIVIDUAL file folder to save the new file in
Path = FolderName & "\" & ws.Name & " - " & CellData
MkDir Path

FName = Path & "\" & ws.Name & " - " & CellData & ".pdf"

ws.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FName
End Select
Next ws

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
 

Forum statistics

Threads
1,148,364
Messages
5,746,272
Members
424,002
Latest member
anon341

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top