SaveAsPDF overwrite check

[drefiek2]

Hi, I have the below code which works great. I want to add a section so that it will check whether the PDF already exists in the given SharePoint folder (an overwrite warning essentially). A popup box should come up if the file already exists and the user can either click yes or no to overwrite, and then the rest of the code should work as already programmed.

Note that a team of colleagues use this spreadsheet via SharePoint. Everyone has linked the SharePoint folder with their individual OneDrive, and therefore we all access the spreadsheet via our individual OneDrives in My Files. Everything syncs with SharePoint and works great, I just need to add the above additional section into the code.

Sub SaveAsPDF()
'
' SaveAsPDF Macro
'
' Keyboard Shortcut: Ctrl+Shift+S
'
 Select Case MsgBox("Have you checked the date and shift are correct?", vbYesNo Or vbQuestion, Application.Name)
    Case vbNo
        Debug.Print "User exit"
        Exit Sub
    End Select
    Dim SharePointPath As String
    Dim PdfFileName As String
    Dim msg As String

    On Error GoTo SaveError

    SharePointPath = "https://company.sharepoint.com/examplefolder/" '<<<<<<<<<<<< edit as required.

    PdfFileName = Replace(Range("D6").Value, "/", "") & ActiveSheet.Range("J6").Value
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=SharePointPath & PdfFileName, _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    msg = "Handover successfully uploaded to SharePoint."
    MsgBox msg, vbInformation, "Upload Successful"
    Exit Sub

SaveError:
    msg = "Handover was not uploaded to SharePoint. Please contact X on e-mail and use the backup document for today." & vbCr & vbCr & Err.Number & " - " & Err.Description
    MsgBox msg, vbCritical, "Upload Failure"
End Sub

 

[Herakles]

I have added another reuseable function to do the actual save.

You may want to make reference to the actual worksheet rather than depend on the active sheet being the right one.

I've not tested this saving to a SharePoint folder.

Sub SaveAsPDF()
'
' SaveAsPDF Macro
'
' Keyboard Shortcut: Ctrl+Shift+S
'
Dim SharePointPath As String
Dim PdfFileName As String
Dim msg As String
    
    On Error GoTo SaveError
    
    If MsgBox("Have you checked the date and shift are correct?", vbYesNo, Application.Name) = vbNo Then
        Exit Sub
    End If
    
    SharePointPath = "https://company.sharepoint.com/examplefolder/" '<<<<<<<<<<<< edit as required.

    PdfFileName = Replace(Range("D6").Value, "/", "") & ActiveSheet.Range("J6").Value
        
    If fncExportToPDF(ActiveSheet, SharePointPath & PdfFileName) Then
        MsgBox "Handover successfully uploaded to SharePoint.", vbInformation, "Upload Successful"
        Exit Sub
    End If
        
SaveError:
    msg = "Handover was not uploaded to SharePoint. Please contact X on e-mail and use the backup document for today." & vbCr & vbCr & Err.Number & " - " & Err.Description
    MsgBox msg, vbCritical, "Upload Failure"

End Sub

Public Function fncExportToPDF(Ws As Worksheet, strFileName As String) As Boolean

On Error GoTo Err_Handler

    If Len(Dir(strFileName)) > 0 Then
        If MsgBox("This file already exists, do you want to overwrite it?", vbYesNo, "Warning!") = vbNo Then
            Exit Function
        End If
    End If
    
   Ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    fncExportToPDF = True

Exit_Handler:

    Exit Function

Err_Handler:

    fncExportToPDF = False
    
    Resume Exit_Handler
    
End Function

 

[drefiek2]

I have added another reuseable function to do the actual save.

You may want to make reference to the actual worksheet rather than depend on the active sheet being the right one.

I've not tested this saving to a SharePoint folder.

Sub SaveAsPDF()
'
' SaveAsPDF Macro
'
' Keyboard Shortcut: Ctrl+Shift+S
'
Dim SharePointPath As String
Dim PdfFileName As String
Dim msg As String
   
    On Error GoTo SaveError
   
    If MsgBox("Have you checked the date and shift are correct?", vbYesNo, Application.Name) = vbNo Then
        Exit Sub
    End If
   
    SharePointPath = "https://company.sharepoint.com/examplefolder/" '<<<<<<<<<<<< edit as required.

    PdfFileName = Replace(Range("D6").Value, "/", "") & ActiveSheet.Range("J6").Value
       
    If fncExportToPDF(ActiveSheet, SharePointPath & PdfFileName) Then
        MsgBox "Handover successfully uploaded to SharePoint.", vbInformation, "Upload Successful"
        Exit Sub
    End If
       
SaveError:
    msg = "Handover was not uploaded to SharePoint. Please contact X on e-mail and use the backup document for today." & vbCr & vbCr & Err.Number & " - " & Err.Description
    MsgBox msg, vbCritical, "Upload Failure"

End Sub

Public Function fncExportToPDF(Ws As Worksheet, strFileName As String) As Boolean

On Error GoTo Err_Handler

    If Len(Dir(strFileName)) > 0 Then
        If MsgBox("This file already exists, do you want to overwrite it?", vbYesNo, "Warning!") = vbNo Then
            Exit Function
        End If
    End If
   
   Ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    fncExportToPDF = True

Exit_Handler:

    Exit Function

Err_Handler:

    fncExportToPDF = False
   
    Resume Exit_Handler
   
End Function

Hi there, thanks for your reply! I get an error message, simply "0 -" and no other error details.

 

[Herakles]

Try using a local path as that is the only part that I could not test.

If it works for a local path then it maybe the sharepoint path that is the problem.

What value dores PdfFileName have?

 

[drefiek2]

Try using a local path as that is the only part that I could not test.

If it works for a local path then it maybe the sharepoint path that is the problem.

What value dores PdfFileName have?

Hi Herakles, changed to local path Downloads folder, it overwrites without warning.

PdfFileName is cell D6 (date field 05/06/2023) and cell J6 ("Day" or "Night" in a drop down list). The script removes the / in the date as it is illegal in file name saves, so the saved file name is for example 05062023Day.pdf

 

[drefiek2]

Any other suggestions or ideas would be greatily appreciated