Save as PDF - From onedrive

[kgkev]

Hi, I have a code which has worked well for a long time, but I noticed that if a file is saved in onedrive it goes to the Else '//Error: file path not found


Is there a simple work around for this?

Private Sub Save_as_pdf()
Dim FSO As Object
Dim s(1) As String
Dim sNewFilePath As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    s(0) = ActiveWorkbook.FullName
    If FSO.FileExists(s(0)) Then
        '//Change Excel Extension to PDF extension in FilePath
        s(1) = FSO.GetExtensionName(s(0))
        If s(1) <> "" Then
            s(1) = "." & s(1)
            sNewFilePath = Replace(s(0), s(1), ".pdf")
            '//Export to PDF with new File Path
            ActiveSheet.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                filename:=sNewFilePath, _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, OpenAfterPublish:=True
        End If
    Else '//Error: file path not found
        MsgBox "Error: this workbook may be unsaved.  Please save and try again."
    End If
    Set FSO = Nothing
End Sub

 

[Artik]

Microsoft recommends synchronizing OneDrive with your disk space.

Try the code below.
You can also use "OneDriveCommercial" or "OneDriveConsumer" as an environment variable in the Environ function, depending on which OneDrive you want to reference.

Private Sub Save_as_pdf()
    Dim FSO As Object
    Dim s(1) As String
    Dim sNewFilePath As String
    Dim lPos As Long
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    s(0) = ActiveWorkbook.FullName

    If s(0) Like "https://*" Then
        lPos = InStr(1, s(0), "Documents/", vbTextCompare) + Len("Documents/") - 1

        s(0) = Environ("OneDrive") & Replace(Mid(s(0), lPos), "/", "\")
    End If

    If FSO.FileExists(s(0)) Then
        s(1) = FSO.GetBaseName(s(0))
        If s(1) <> "" Then
            sNewFilePath = FSO.GetFile((s(0))).ParentFolder.Path & "\" & s(1)

            '//Export to PDF with new File Path
            ActiveSheet.ExportAsFixedFormat _
                    Type:=xlTypePDF, _
                    Filename:=sNewFilePath, _
                    Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                    IgnorePrintAreas:=False, OpenAfterPublish:=True
        End If
    Else    '//Error: file path not found
        MsgBox "Error: this workbook may be unsaved.  Please save and try again."
    End If
    Set FSO = Nothing
End Sub

Artik

 

[kgkev]

brilliant - works perfecting in & out of onedrive.

Thanks