Saving PDF to specific folder

[Frankietheflyer]

Hi

I've built a code that searches through a list (rngWB) of excel workbooks and produces them as PDFs. The code works well, but insists on saving the individual PDFs to my Documents folder.

I want them to be save to a folder in my documents, but that is further named by the contents of a cell.

The code can create the folder if it doesn't already exist, but whatever I seem to do with the "Filename" part of producing the PDF, I can't get the files into the new folder.

Any ideas how to get the PDF file named with rngWB to save into the FolderName please??

[FONT=Verdana]Private Sub CommandButton1_Click()
Dim ws As Worksheet, wsRO As Worksheet
Dim fdObj As Object
Application.ScreenUpdating = False[/FONT]
[FONT=Verdana]If Dir(("C:\Users\") & Environ("USERNAME") & ("\Documents\PDF Sheets for Meeting ") & ThisWorkbook.Sheets("Running Order").Range("F1").Value, vbDirectory) = "" Then
  MkDir Path:="C:\Users\" & Environ("USERNAME") & ("\Documents\PDF Sheets for Meeting ") & ThisWorkbook.Sheets("Running Order").Range("F1").Value[/FONT]
[FONT=Verdana]Call PDFSheets[/FONT]
[FONT=Verdana]Else[/FONT]
[FONT=Verdana]Call PDFSheets[/FONT]
[FONT=Verdana]End If[/FONT]
[FONT=Verdana]Application.ScreenUpdating = True[/FONT]
[FONT=Verdana]End Sub
[/FONT]
[FONT=Verdana]Sub PDFSheets()[/FONT]
[FONT=Verdana]Dim xCell As Range, xYesorNo As Integer
Dim myFile As Variant, FolderName As String
Dim strPath As String[/FONT]
[FONT=Verdana]Dim ws As Worksheet, wsRO As Worksheet, wsRes As Worksheet, wsPoi As Worksheet, rngWB As Range[/FONT]
[FONT=Verdana]
Application.ScreenUpdating = False[/FONT]
[FONT=Verdana]
Set wsRO = ThisWorkbook.Sheets("Running Order")[/FONT]
[FONT=Verdana]   FolderName = "C:\Users\" & Environ("USERNAME") & ("\Documents\PDF Sheets for Meeting ") & ThisWorkbook.Sheets("Running Order").Range("F1").Value
   
       strPath = Environ("USERPROFILE") & ("\Documents\") & wsRO.Range("F1").Value & ("\")
  
    
   For Each rngWB In wsRO.Range("AZ4", wsRO.Range("AZ" & Rows.Count).End(xlUp))
         With Workbooks.Open(strPath & rngWB.Value & ".xlsx")
            For Each ws In .Worksheets[/FONT]
[FONT=Verdana]ws.Range("B2:AL113").ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
        
ActiveWorkbook.Close savechanges:=True[/FONT]
[FONT=Verdana]
Application.ScreenUpdating = True[/FONT]
[FONT=Verdana]
Next[/FONT]
[FONT=Verdana]End With[/FONT]
[FONT=Verdana]Next rngWB[/FONT]
[FONT=Verdana]MsgBox "Team Sheet PDFs have been produced and are in your Document folder" & Chr(13) & Chr(13) & "PDF Sheets for Meeting " & ThisWorkbook.Sheets("Running Order").Range("F1").Value[/FONT]
[FONT=Verdana]End Sub
[/FONT]

Thanks

FTF

 

[Yongle]

Try inserting this line

With Workbooks.Open(strPath & rngWB.Value & ".xlsx")
  For Each ws In .Worksheets[COLOR=#ff0000]
     myFile = FolderName & "\" & rngWB.Value & ".pdf"[/COLOR]

ws.Range("B2:AL113").ExportAsFixedFormat _
  Type:=xlTypePDF, _
  Fillename:=myFile, _
  Quality:=xlQualityStandard, _
  IncludeDocProperties:=True, _
  IgnorePrintAreas:=False, _
  OpenAfterPublish:=False

 

[Frankietheflyer]

Excellent!! Thanks Yongle.