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

Question

想知道是否还有其他人遇到过将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

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