将 Sharepoint 文件路径转换为本地文件路径

Question

任何人都可以帮我找到以下问题的解决方案吗？我希望能够在启用“自动保存”之前确定 Sharepoint 是否可用。有其他人遇到过将 Sharepoint 文件路径转换为本地文件路径的问题吗？

下面的代码查找文件名的各个组成部分，然后将它们写入所选工作表中的特定单元格。

有没有办法通过在打开自动保存之前检查 Sharepoint 状态来避免这种（偶尔）错误？

    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

第二个宏仅用于列出所有环境变量，以防我使用的环境变量未提供正确答案。

Answer 1

函数 URLConverter（URL 作为字符串）

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) 如果 b = 0 则 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

结束功能

函数 FindRev(rng 作为字符串，Str 作为字符串) FindRev = InStrRev(rng, Str, -1, vbBinaryCompare) 如果 FindRev = 0 则 FindRev = Len(rng) + 1 结束功能

函数 ReplaceAll(rng 作为字符串，Str 作为字符串，Str2 作为字符串)

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

结束功能