Macro to print to PDF saves files to desktop

[rachel06]

Hi, me again!

Hoping this is an easy one. I'm working a macro that's going to open a handful of Excels from a folder and do a few different tasks. One task it's going to do is print the Excel to a PDF.

I've got that part working, kind of - Instead of the PDFs saving to the folder on my desktop that the Excel files are located in, they're going onto my desktop directly. How can I correct this? I'd like them to save to the save file the Excel files are in.

The part I'm having issues with is noted with 'Currently Saves PDFs to Desktop - FIX in the below code but I'm sure you all knew that

Sub ListAllFiles()

Dim MyPath As String
Dim MyFile As String
Dim wb As Workbook
Dim FldrPicker As FileDialog
Dim sh As Worksheet
Dim i As Integer

Set sh = ThisWorkbook.Sheets("Output")
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
        .Title = "Please Select Folder"
        .AllowMultiSelect = False
        .ButtonName = "Select"
        If .Show = -1 Then
            MyPath = .SelectedItems(1) & "\"
        Else
            End
       End If
    End With
       
MyFile = Dir(MyPath)
i = 2

Do While MyFile <> ""

  
    sh.Cells(i, 1) = MyFile
    MyFile = Dir
    i = i + 1
    
'''''code for open and search here'''''
    
    'Open File
    Set wb = Workbooks.Open(fileName:=MyPath & MyFile)
    
    'Ensure Workbook has opened before moving on to next line of code
     DoEvents
     
    'Save and Close Workbook as PDF
    'Currently Saves PDFs to Desktop - FIX
      ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, fileName:=sPath, _
       Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False
      wb.Close SaveChanges:=False
      
'''''code for open and search here'''''
    
Loop




End Sub

Bonus question: after it finishes the last Excel, I get a Run-Time 1004 error that it couldn't find the folder the Excels were in. It says something about "Is it possible it was moved, renamed or deleted?" I'm guessing it has something to do with reaching the end of the Excel files but I'm not sure. I'm kind of just piecing the things I find together to make this work!

Thank you, thank you!!

 

[Logit]

This will save specific sheets to the same folder as the workbook.

Option Explicit

Sub SendPrelimTest()
    Dim FileNameArray As String
    Dim FilePath As String
    Dim PrelimName As String
    Dim Filename As String
        
        FilePath = ThisWorkbook.Path & "\"
        Filename = ThisWorkbook.Name & ".pdf"
        Sheets(Array(2, 3)).Select                                 'Select sheets to save as PDF here
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                        Filename:=FilePath & Filename, _
                                        IncludeDocProperties:=False
        MsgBox "PDF file has been created: " & vbNewLine _
             & "Please look over File and make changes if needed."
        
    
End Sub

 

[rachel06]

This will save specific sheets to the same folder as the workbook.

Option Explicit

Sub SendPrelimTest()
    Dim FileNameArray As String
    Dim FilePath As String
    Dim PrelimName As String
    Dim Filename As String
       
        FilePath = ThisWorkbook.Path & "\"
        Filename = ThisWorkbook.Name & ".pdf"
        Sheets(Array(2, 3)).Select                                 'Select sheets to save as PDF here
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                        Filename:=FilePath & Filename, _
                                        IncludeDocProperties:=False
        MsgBox "PDF file has been created: " & vbNewLine _
             & "Please look over File and make changes if needed."
       
   
End Sub

Thanks, but I'm not looking for specific sheets in the workbook. It's multiple workbooks with one sheet each. Currently, what I have kind of works, but it's saving the PDFs to my desktop instead of the source folder. That's where I'm stuck.

 

[Logit]

Are you wanting to save the same sheet from each workbook as a PDF file ? Or ...
Are you wanting to save each workbook as a PDF file ?

 

[jolivanes]

Sub Print_All_To_PDF()
Dim mydir As String, myfile As String, mybook As Workbook
    mydir = ThisWorkbook.Path & "\"
    myfile = Dir(mydir & "*.xl*")
    Application.ScreenUpdating = False
    Do While myfile <> ""
        If myfile <> ThisWorkbook.Name Then
        Set mybook = Workbooks.Open(mydir & myfile)
            ActiveSheet.UsedRange.ExportAsFixedFormat 0, ThisWorkbook.Path & "\" & Left(myfile, InStrRev(myfile, ".") - 1) & ".PDF"
        mybook.Close False
        End If
        myfile = Dir()
    Loop
    Application.ScreenUpdating = True
End Sub

If you do reply to this post, do not quote this post. I happen to know what I posted and it does not need to be in the following post again.

 

[rachel06]

Are you wanting to save the same sheet from each workbook as a PDF file ? Or ...
Are you wanting to save each workbook as a PDF file ?

Each workbook. That's what it's doing now, but for some reason it's going to my desktop instead of the source folder.

 

[rachel06]

Actually, another question. How would I modify my existing to code to, instead of having a dialog box pop up to choose the folder where the files are saved, to having it reference a cell where I could have the file path? I'm thinking if I do that instead, I could use that to reference both the source folder for the workbooks AND the save location?

 

[Logit]

The following macro utilizes cell A1 of Sheet1 for the saving path :

Option Explicit

Sub SaveAllWorkbooksAsPDF()
    Dim srcWorkbook As Workbook
    Dim wb As Workbook
    Dim filePath As String
    Dim referenceCell As Range
    Dim folderPath As String
    Dim fileName As String
    Dim file As String
    
    ' Set the source workbook
    Set srcWorkbook = ThisWorkbook
    
    ' Get the file path from a reference cell (change "Sheet1" and "A1" as needed)
    Set referenceCell = srcWorkbook.Sheets("Sheet1").Range("A1")
    filePath = referenceCell.Value
    
    ' Check if the reference cell is not empty
    If filePath = "" Then
        MsgBox "Reference cell is empty. Please provide a file path."
        Exit Sub
    End If
    
    ' Add a trailing backslash to the folder path if it doesn't have one
    If Right(filePath, 1) <> "\" Then
        folderPath = filePath & "\"
    Else
        folderPath = filePath
    End If
    
    ' Get the first file in the folder
    file = Dir(folderPath & "*.xls*")
    
    ' Loop through all Excel files in the folder
    Do While file <> ""
        ' Exclude the source workbook
        If file <> srcWorkbook.Name Then
            ' Open the workbook
            Set wb = Workbooks.Open(folderPath & file)
            
            ' Save as PDF
            fileName = Left(file, InStrRev(file, ".") - 1) & ".pdf"
            wb.ExportAsFixedFormat Type:=xlTypePDF, fileName:=folderPath & fileName
            
            ' Close the workbook without saving changes
            wb.Close SaveChanges:=False
        End If
        
        ' Get the next file in the folder
        file = Dir
    Loop
    
    MsgBox "All workbooks saved as PDFs."
End Sub

 

[rachel06]

Thanks, @Logit! That'll get me going in the right direction. I can build around this now for everything else I need it to do. I was able to quickly get my formatting for the PDFs in here as well!

 

[Logit]

You are welcome. Best wishes.