Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Save Worksheet to PDF and Create a Directory When Needed, for both Windows and MacOS

I'm in a bit of fix here as this code works perfectly for windows [my own OS]. The aim of the code is to save a particular worksheet in a filename each time. If the directory doesn't exist, it will also create the directory to store the filename.

However, when tried on a MacOS, it just produces an error. No PDF gets created or saved. It simply manages to highlight the area to save to PDF. That's all.

Any ideas?

Sub SaveSelectionAsPDF()

Dim saveLocation As String
Dim CheckOS, PoNumber As String
Dim RememberFirstRow, RememberLastRow As Integer
Dim saveDirectory As String


Worksheets("PO_Formatted").Activate
CheckOS = Application.OperatingSystem
PoNumber = Cells(11, 3).Value

If InStr(1, CheckOS, "Windows") > 0 Then

saveDirectory = "C:\Users\" & Environ("username") & "\Desktop\PO Sheets\" & Format(Date, "dd-mmm-yyyy") & "\"
saveLocation = "C:\Users\" & Environ("username") & "\Desktop\PO Sheets\" & Format(Date, "dd-mmm-yyyy") & "\" & Cells(11, 3).Value & ".pdf"

Call CreateDir(saveDirectory)



Else

saveLocation = "/Users/username/Desktop/" & Cells(11, 3).Value & ".pdf"

End If

    Range("B1000").Select
    Selection.End(xlUp).Select
    Range(ActiveCell.Offset(1, -1), Cells(1, 10)).Select

Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=saveLocation, OpenAfterPublish:=True

Worksheets("PO_Sheet").Activate
For i = 4 To ActiveSheet.UsedRange.Rows.Count
    If Cells(i, 4).Value = PoNumber Then
        Cells(i, 21).Value = "Confirmed"
    End If
Next i

Worksheets("PO_Formatted").Activate
End Sub



Sub CreateDir(strPath As String)
    Dim elm As Variant
    Dim strCheckPath As String

    strCheckPath = ""
    For Each elm In Split(strPath, "\")
        strCheckPath = strCheckPath & elm & "\"
        If Len(Dir(strCheckPath, vbDirectory)) = 0 Then MkDir strCheckPath
    Next

End Sub

So it works perfectly on Windows, but not MacOS, where it just produces an error. No PDF gets created or saved. It simply manages to highlight the area to save to PDF. That's all.

like image 637
orangeonly87 Avatar asked Oct 26 '25 08:10

orangeonly87


1 Answers

Export Range to PDF for Windows and MacOS

  • I don't have a Mac so any feedback is most welcome.
Option Explicit

Sub ExportRangeToPDF()

    Dim pSep As String: pSep = Application.PathSeparator
    
    Dim FolderPath As String: FolderPath = Environ("USERPROFILE") _
        & pSep & "Desktop" & pSep & "PO Sheets" & pSep _
        & Format(Date, "dd-mmm-yyyy")
    CreateFolder FolderPath
    'ThisWorkbook.FollowHyperlink FolderPath ' explore the folder
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim fws As Worksheet: Set fws = wb.Sheets("PO_Formatted")
    Dim frg As Range: Set frg = fws.Range("J1", _
         fws.Cells(fws.Rows.Count, "B").End(xlUp).Offset(1, -1)) ' ? 1 = 0 ?
    
    Dim PoNumber As String: PoNumber = fws.Range("C11").Value
    Dim FilePath As String: FilePath = FolderPath & pSep & PoNumber & ".pdf"
    
    frg.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FilePath, _
        OpenAfterPublish:=True
    
    Dim sws As Worksheet: Set sws = wb.Sheets("PO_Sheet")
    
    Dim r As Long
    
    For r = 4 To sws.UsedRange.Rows.Count
        If CStr(sws.Cells(r, "D").Value) = PoNumber Then
            sws.Cells(r, "U").Value = "Confirmed"
        End If
    Next r
    
    MsgBox "Range exported to PDF.", vbInformation
    
End Sub

Create Folder

Sub CreateFolder(ByVal FolderPath As String)

    Dim pSep As String: pSep = Application.PathSeparator
    
    Do While Right(FolderPath, 1) = pSep ' remove trailing path separators
        FolderPath = Left(FolderPath, Len(FolderPath) - 1)
    Loop
    
    Dim SplitPath() As String: SplitPath = Split(FolderPath, pSep)
    
    Dim n As Long, JoinedPath As String
    
    Do While Len(SplitPath(n)) = 0 ' handle leading path separators
        JoinedPath = JoinedPath & pSep
        n = n + 1
    Loop
  
    For n = n To UBound(SplitPath)
        JoinedPath = JoinedPath & SplitPath(n) & pSep
        If Len(Dir(JoinedPath, vbDirectory)) = 0 Then MkDir JoinedPath
    Next n

End Sub
like image 195
VBasic2008 Avatar answered Oct 28 '25 23:10

VBasic2008