Convert Sharepoint FIle Path to Local File Path

Question

Can anyone help me find a solution to the problem below? I'd like to be able to determine whether Sharepoint is available before I turn Autosave one. Has anyone else has faced the issue of converting Sharepoint file path to a local file path?

The code below finds various components of the file names and then writes them to specific cells in the chosen worksheet.

Is there a way to avoid this (occasional) error by checking the Sharepoint status before Autosave is turned on?

    Sub ConvertSharepointPath()
    Dim FilePath As String, FileName As String
    Dim Path As String, Path2 As String, ExtOnly As String, NameOnly As String 
    Dim LocalRoot As String, LocalFullPath As String
    Dim SrchStr As String, ReplStr As String
    
    ' Find current path settings for the active workbook
    With ActiveWorkbook
        FilePath = .FullName
        FileName = .Name
        Path = .Path
    End With
    
    NameOnly = Left(FileName, InStr(1, FileName, ".") - 1)
    ExtOnly = Right(FileName, Len(FileName) - InStr(1, FileName, "."))
    
    ' Strip out all text in path using the sharepoint locations
    ' For me, the string ".sharepoint.com/sites/" is preceded by a string specific to my installation.
    ' This code stripe that out and stores the directory structure in Path2
    SrchStr = ".sharepoint.com/sites/"
    Path2 = Right(Path, Len(Path) - (InStr(1, Path, SrchStr) + Len(SrchStr) - 1))
    
    ' Convert backward slash to forward slash, in order to adapt the directory location to a Windows naming convention
    SrchStr = "/"
    ReplStr = "\"
    Path2 = Replace(Path2, SrchStr, ReplStr)
    
    ' I have "\Shared" in the Sharepoint path and need " - " in the local path
    SrchStr = "\Shared "
    ReplStr = " - "
    Path2 = Replace(Path2, SrchStr, ReplStr)
    
    ' Find local path to OneDrive files, can use either "OneDrive" or "OneDriveCommercial"
    LocalRoot = Environ$("OneDriveCommercial")
    ' Need to remove "OneDrive - " as this isn't present in my local path
    SrchStr = "OneDrive - "
    LocalRoot = Left(LocalRoot, InStr(1, LocalRoot, SrchStr) - 1) & Right(LocalRoot, Len(LocalRoot) - (InStr(1, LocalRoot, SrchStr) + Len(SrchStr) - 1)) & "\" & Path2
    LocalFullPath = LocalRoot & "\" & Path2 & "\" & FileName
    
    ' Display various name components
    Sheets("Tracking").Activate
    With Range("A11")
        .Offset(0, 0) = "Sharepoint Full Name: "
        .Offset(0, 1) = FilePath
        .Offset(1, 0) = "File Name: "
        .Offset(1, 1) = FileName
        .Offset(2, 0) = "File Name w/o Ext: "
        .Offset(2, 1) = NameOnly
        .Offset(3, 0) = "File Ext: "
        .Offset(3, 1) = ExtOnly
        .Offset(4, 0) = "Sharepoint File Path: "
        .Offset(4, 1) = Path
        .Offset(5, 0) = "Local Path Ending: "
        .Offset(5, 1) = Path2
        .Offset(6, 0) = "Local File Path: "
        .Offset(6, 1) = LocalRoot
        .Offset(7, 0) = "Local Full Path: "
        .Offset(7, 1) = LocalFullPath
    End With

    End Sub

    Sub ListEnvVariables()
    ' Adapted from https://wellsr.com/vba/2019/excel/list-all-environment-variables-with-vba-environ/

    Dim EnvStr As String
    Dim EnvSplit As Variant
    Dim i As Integer, j As Integer
    
    For i = 1 To 255
        EnvStr = Environ$(i)
        If Len(EnvStr) = 0 Then GoTo iNext:
        EnvSplit = Split(EnvStr, "=")
        With Range("A20")
            .Offset(i, 0).Value = i
            For j = 1 To UBound(EnvSplit)
                .Offset(i, j).Value = EnvSplit(j - 1)
            Next j
        End With
    iNext:
    Next i

    End Sub

The second macro is used simply to list all of the Environmental variables in the event that the ones I've used don't provied the correct answer.

Answer 1

'This code converts Edge copied URL into Mapped Local Type URL

Function URLConverter(URL As String)

Dim a As Long, b As Long
If InStr(1, URL, "=", vbBinaryCompare) <> 0 Then

' l = InStrRev(Url, "=", -1, vbBinaryCompare) a = InStr(1, URL, "%2F", vbBinaryCompare) - 1 'WorksheetFunction.Find("%2F", Url, 1) - 1 b = InStr(a + 1, "&", URL, vbBinaryCompare) If b = 0 Then b = Len(URL)

'    abc = Mid(Url, a, b - a)
'    bcd = Left(abc, FindRev(abc, "&") - 1)
'    gef = ReplaceAll(ReplaceAll(ReplaceAll(bcd, "%5F", "_"), "%2D", "-"), "%2F", "/")
'    pqr = Left(Url, WorksheetFunction.Find(".com", Url, 1)) & gef
    
    
    URLConverter = Left(URL, WorksheetFunction.Find(".com", URL, 1) + 3) & _
        ReplaceAll(ReplaceAll(ReplaceAll(Left(Mid(URL, a + 1, b - a), FindRev(Mid(URL, a + 1, b - a), "&") - 1), "%5F", "_"), "%2D", "-"), "%2F", "/")
Else
    URLConverter = URL
End If

If InStr(1, URLConverter, "=", vbBinaryCompare) <> 0 Then
    URLConverter = Left(URLConverter, InStr(1, URLConverter, "&", vbBinaryCompare) - 1)
End If

End Function

Function FindRev(rng As String, Str As String) FindRev = InStrRev(rng, Str, -1, vbBinaryCompare) If FindRev = 0 Then FindRev = Len(rng) + 1 End Function

Function ReplaceAll(rng As String, Str As String, Str2 As String)

Dim i As Long, txt As String, n As Long
i = Len(Str)

For i = 1 To Len(rng)
    txt = txt & Mid(rng, i, 1)
    txt = Replace(txt, Str, Str2, 1, Len(Str), vbBinaryCompare)
Next i
ReplaceAll = txt

End Function