I wrote a code for PDF export in Excel for Mac Office 2019 with a variable filename. It's working despite Mac's permission bugs with VBA saving as when using the makro for the first time Excel asks for the permission to access the concerning folder.
My question:
Can I anyhow give new users the option to choose their exporting path the first time they are using the makro or do I have to adjust the code for every new user personally?
Here's my (otherwise working) code so far:
Sub als_PDF_speichern_recorded_mac()
ChDir "/Users/Admin/Documents/Dokumente/Finanzen/2021/Rechnungen 2021/"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
"/Users/Admin/Documents/Dokumente/Finanzen/2021/Rechnungen 2021/Rechnung_" & ActiveSheet.Range("D11") & ".pdf" _
, Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
End Sub
EDIT
I might have a solution working universally for Mac users. It's not following my original intent that users can choose the path at first use but it's supposed to be exporting the PDF to the current path of the workbook and creating a folder if not existing already.
Please could someone with Excel for Mac (I'm using 2019) confirm:
Sub exportPDF_mac()
'export to currentpath/greatnewfolder
ChDir "/" & ActiveWorkbook.Path
MakeFolderIfNotExist (ThisWorkbook.Path & Application.PathSeparator & "greatnewfolder")
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
"/" & ActiveWorkbook.Path & "/greatnewfolder/greatfile_" & ActiveSheet.Range("D11") & ".pdf" _
, Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
End Sub
Function MakeFolderIfNotExist(Folderstring As String)
' Ron de Bruin, 2-March-2019
' http://www.rondebruin.nl/mac/mac010.htm
Dim ScriptToMakeFolder As String
Dim TestStr As String
Dim FolderStr As String
If Val(Application.Version) < 15 Then
ScriptToMakeFolder = "tell application " & Chr(34) & _
"Finder" & Chr(34) & Chr(13)
ScriptToMakeFolder = ScriptToMakeFolder & _
"do shell script ""mkdir -p "" & quoted form of posix path of (" & _
Chr(34) & Folderstring & Chr(34) & ")" & Chr(13)
ScriptToMakeFolder = ScriptToMakeFolder & "end tell"
On Error Resume Next
MacScript (ScriptToMakeFolder)
On Error GoTo 0
Else
FolderStr = MacScript("return POSIX path of (" & _
Chr(34) & Folderstring & Chr(34) & ")")
On Error Resume Next
TestStr = Dir(FolderStr & "*", vbDirectory)
On Error GoTo 0
If TestStr = vbNullString Then
MkDir FolderStr
End If
End If
End Function
Thanks in advance!
Thomas
I'm trying to help my mum remotely with her problem: she needs to save a workbook as an xlsx and a PDF. Here's my code:
Sub sb_Copy_Save_ActiveSheet_As_Workbook()
Dim wksht As Worksheet
Set wksht = ActiveSheet
Dim path As String
path = "C:\Users\" & Environ$("Username") & "\Company Name\Company Name Team Site - Documents\PO Numbers\"
wksht.Copy
ActiveWorkbook.SaveAs Filename:=path & wksht.Range("G1") & " " & wksht.Range("F1").Value & ".xlsx"
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF FileName:=path & wksht.Range("G1") & " " & wksht.Range("F1").Value & ".pdf" Quality:=xlQualityStandard OpenAfterPublish:=True
End Sub
We got it working to the point where she can save an xlsx file in the specified filepath, but attempting to export it as a PDF isn't working. She says she's getting a syntax error, but as I don't have excel myself I can't test it. I've looked at some similar questions but I can't seem to find an answer.
Thanks very much in advance
you just need to add commas so that
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF FileName:=path & wksht.Range("G1") & " " & wksht.Range("F1").Value & ".pdf" Quality:=xlQualityStandard OpenAfterPublish:=True
becomes
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:=path & wksht.Range("G1") & " " & wksht.Range("F1").Value & ".pdf", Quality:=xlQualityStandard, OpenAfterPublish:=True
I am trying to convert an excel sheet to pdf than save it to a folder on my desktop, however, I keep getting a run time error of 1004 - application-defined or object defined error. I have placed the code below. Can anyone please assist?
Private Sub pdfAlternate()
Dim strPathLocation As String
Dim strFilename As String
Dim strPathFile As String
Dim fileSaveName As String
Dim fileSavePath As String
Dim pdfOpenAfterPublish As Boolean
strPathLocation = Worksheets("Form").Range("C11").Value
strFilename = Worksheets("Form").Range("L11").Value
fileSaveName = strPathLocation & "_" & strFilename
fileSavePath = "C:\Users\fou55227\Desktop\BMW" & "\" & fileSaveName & "_" & Format(Date, "MM.DD.YYYY") & ".pdf"
ActiveWorkbook.Sheets("Form").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
fileSavePath _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
Debug.Print fileSaveName
Debug.Print fileSavePath
End Sub
Below code works fine until generate a filename. It picks up the correct folder location, but the file name is blank.
If I choose location somewhere on my local machine, the filename appears then. Could you advise me what should I do differently, please?
Private Sub CBSaveasPDF_Click()
Dim FileAndLocation As Variant
Dim strPathLocation As String
Dim strFilename As String
Dim strPathFile As String
strPathLocation = "http://teams.xxx.intranet/sites/bipm/test/test/test/test/test/"
strFilename = Me.Range("D8") & " -" & Me.Range("D7") & " -" & Me.Range("J7") & " " & Me.Range("B3")
strPathFile = strPathLocation & strFilename
FileAndLocation = Application.GetSaveAsFilename _
(InitialFileName:=strPathLocation & strFilename, _
filefilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If FileAndLocation = "False" Then
MsgBox ("Document not saved")
Exit Sub
End If
Me.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strFilename, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
I have combined some code from a couple of different examples to get this to work but my solution seems klunky in that I am creating 2 pdfs. One in a temp folder, and one in the current folder. The one in the temp folder is the one getting attached to the email. I would like to just save a single pdf in the current folder and attach that pdf to the email.
This is the code that exports both pdf's:
Title = ActiveSheet.Range("B11").Value & " Submittal"
' Define PDF filename in TEMP folder
PdfFile = ActiveWorkbook.Name
i = InStrRev(PdfFile, ".xl", , vbTextCompare)
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = Title
For Each char In Split("? "" / \ < > * | :")
PdfFile = Replace(PdfFile, char, "_")
Next
PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Range("B11").Value & " Submittal", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End With
For some reason, if I add ThisWorkbook.Path & "\" to the Filename of the first exported file like this: Filename:=ThisWorkbook.Path & "\" & PdfFile, so it saves in the current folder instead of the temp folder, I get a runtime error and it doesn't save even though this is the same code that exports the second pdf file successfully to the current folder.
Here is the full working code but I want to eliminate the temp pdf if possible:
Sub RightArrow2_Click()
Dim IsCreated As Boolean
Dim PdfFile As String, Title As String
Dim OutlApp As Object
Dim i As Long
Dim char As Variant
Title = ActiveSheet.Range("B11").Value & " Submittal"
' Define PDF filename in TEMP folder
PdfFile = ActiveWorkbook.Name
i = InStrRev(PdfFile, ".xl", , vbTextCompare)
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = Title
For Each char In Split("? "" / \ < > * | :")
PdfFile = Replace(PdfFile, char, "_")
Next
PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"
'Debug.Print PdfFile
' Export activesheet as PDF to the temporary folder
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Range("B11").Value & " Submittal", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End With
' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
On Error GoTo 0
' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)
' Prepare e-mail
.Subject = Title
.To = ActiveSheet.Range("H12").Value
.CC = ""
.Body = "Please see the attached submittal for " & ActiveSheet.Range("B11").Value & "." & vbLf & vbLf _
& "Thank you," & vbLf & vbLf _
& vbLf
.Attachments.Add PdfFile
' Display email
On Error Resume Next
.Display ' or use .Send
' Return focus to Excel's window
Application.Visible = True
If Err Then
MsgBox "E-mail was not sent", vbExclamation
Else
MsgBox "E-mail successfully sent", vbInformation
End If
On Error GoTo 0
End With
' Delete the temporary PDF file
If Len(Dir(PdfFile)) Then Kill PdfFile
' Try to quit Outlook if it was not previously open
If IsCreated Then OutlApp.Quit
' Release the memory of object variable
' Note: sometimes Outlook object can't be released from the memory
Set OutlApp = Nothing
End Sub
In your description, in the line of code
Filename:=ThisWorkbook.Path & "\" & PdfFile
the PdfFile variable contains the path to the temp folder which is why you get the error.
First, remove this line:
PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) _
& "\" & PdfFile, 251) & ".pdf"
And then this line:
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path _
& "\" & .Range("B11").Value & " Submittal", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
I am not sure how you're creating your filename for your PDF but it should be something like this:
If you retrieve it from a Range:
With Thisworkbook
PdfFile = .Path & Application.PathSeparator & _
.Sheets("SheetName").Range("B11") & "Submittal.pdf"
End With
If you need to do manipulations on the text like what you did:
Title = ActiveSheet.Range("B11").Value & " Submittal"
PdfFile = Title
For Each c In Split("? "" / \ < > * | :")
PdfFile = Replace(PdfFile, char, "_")
Next
PdfFile = Thisworkbook.Path & Application.PathSeparator & PdfFile & ".pdf"
Once you've created a valid filename, the below code should work:
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=PdfFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With