[pctechdr]

Function SaveAsPDFAndOpenFolder()
On Error GoTo SaveAsPDFAndOpenFolder_Err

Dim savePath As String
Dim reportName As String

' Prompt the user to enter a name for the PDF file
reportName = InputBox("Enter a name for the PDF file (without extension):")

' Check if the user canceled the input
If Len(reportName) = 0 Then
Exit Function
End If

' Append ".pdf" extension to the file name
reportName = reportName & ".pdf"

' Get a folder path from the user
With Application.FileDialog(4) ' msoFileDialogFolderPicker
.Title = "Select a Folder"
.Show
If .SelectedItems.Count > 0 Then
savePath = .SelectedItems(1) & "\" & reportName
Else
' User cancelled the folder picker
Exit Function
End If
End With

' Open the report in Print Preview mode
DoCmd.OpenReport "Πίνακας1", acViewPreview, , , acHidden

' Save the report as PDF
DoCmd.OutputTo acOutputReport, "Πίνακας1", acFormatPDF, savePath

' Close the report
DoCmd.Close acReport, "Πίνακας1"

' Open the folder where the PDF file is saved
Shell "explorer.exe /select," & savePath, vbNormalFocus

SaveAsPDFAndOpenFolder_Exit:
Exit Function

SaveAsPDFAndOpenFolder_Err:
MsgBox Err.Description, vbCritical
Resume SaveAsPDFAndOpenFolder_Exit
End Function

Αντικατέστησε τον κώδικα με αυτόν