使用Excel VBA获取存储在OneDrive中文件的URL

Question

使用Excel VBA获取存储在OneDrive中文件的URL

excelvbaonedrivemicrosoft-file-explorer

3

我的Excel VBA将一个PDF文件保存到本地的OneDrive目录下的"C:\Users\Name\OneDrive\FileName.pdf"。

我需要找到一些代码，以便给出该文件的URL，以便将其输入到单元格中。 URL用于创建QR码，以便任何人都可以读取PDF文件。

目前，我必须手动查找URL并将其粘贴到电子表格中，然后VBA才能创建QR码。

我正在使用Office 365，但是.xlsm文件将分发给使用不同Excel版本的用户。

我已经为此而苦苦挣扎了一段时间，所以如果有人能帮忙，我会非常感激。

CODE:
Sub QrLabelCreate()

'STEP 1:
'Excel VBA put data into a word-document, and export it to pdf-file (saved to OneDrive):
        .ActiveDocument.ExportAsFixedFormat _
        OutputFileName:="C:Users\Name\OneDrive\MyMap\" & ID & ".pdf", _
        ExportFormat:=wdExportFormatPDF
        
'STEP 2: THE PROBLEM
'====== I am not able to create code that gives me the URL to the pdf-file. ==========


'STEP 3:
'The URL is pasted into the spreadsheet, and  VBA creates the QR-code.

End Sub

- eradem

2

请尝试从我的代码库中获取 GetWebPath 函数。 - Cristian Buse

感谢您的帮助，我非常感激。不幸的是，我没有足够的经验来理解如何使用它。似乎使用一千多行代码来查找URL有点过于繁琐了，因为可以通过在文件资源管理器中右键单击文件，然后选择“共享”和“复制”来找到它。该解决方案仅适用于使用Windows和Microsoft Office的PC用户。移动存储在OneDrive中的文件不是一个选项，因为它的URL用于创建写在标签上的QR码，以粘贴到机器上。 - eradem

我不明白将本地路径放入代码与将OneDrive URL放入代码之间的努力差异有多大。我认为解决您的问题的方法是查看URL的外观，然后通过类似于％ID％的东西替换URL中的ID，以给出以下结果：https://d.docs.live.net/f9d8c1184686d493/%ID%.xlsm（这只是一个示例URL！您必须根据自己的OneDrive URL进行调整！），然后像这样生成未来的URL：Replace("https://d.docs.live.net/f9d8c1184686d493/%ID%.xlsm", "%ID%", ID)。 - GWD

工作簿将与多个用户共享。在特定范围内，每个用户将在自己的PC上将地址添加到OneDrive中。然后VBA必须做其余的工作。因此，手动分析URL以找到解决问题的方法是不可能的。如果用户选择使用任何其他云解决方案，则我还必须找到解决谷歌云、Dropbox等问题的方法...我已经学习了您的建议，但我不知道如何使其正常工作。 - eradem

@eradem，我现在发布了一个针对OneDrive/Sharepoint的解决方案，只需要265行代码。如果这仍然对你来说太多了，那么恐怕你就没有办法了，因为这个问题对于一般情况来说并不容易解决。此外，这个解决方案不适用于Google Drive、Dropbox或其他任何除OneDrive之外的东西。 - GWD

2个回答

-1

您可以使用VBA的“ENVIRON”命令获取包含当前用户OneDrive文件夹本地根目录的“OneDrive”环境变量。

例如：

Sub ShowOneDrivePath()
Dim OutputFilePath As String

OutputFilePath = Environ("OneDrive") & "\MyMap\MyPdfName.pdf"

Debug.Print "OneDrive file path is:" & OutputFilePath 

End Sub

- TJMelrose

2

谢谢您的回复。这将帮助我找到文件的本地路径。我的问题是要找到URL；即用户在互联网上查看相同文件所使用的地址。 - eradem

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- GWD · Accepted Answer

一般来说，这并不容易，但幸运的是它与更普遍的问题给定 URL 后查找本地路径相关联。

这就是为什么我现在可以在这里提供一种解决方案。

请注意，该解决方案不会创建 OneDrive 的“共享”链接，要创建此类链接，您需要使用 Microsoft Graph API！此函数创建的链接仅适用于拥有正在同步的远程文件夹的帐户。

要使用我的解决方案，请将以下函数复制到任何标准代码模块中：

'Function for converting OneDrive/SharePoint Local Paths synchronized to
'OneDrive in any way to an OneDrive/SharePoint URL, containing for example
'.sharepoint.com/sites, my.sharepoint.com/personal/, or https://d.docs.live.net/
'depending on the type of OneDrive account and synchronization.
'If no url path can be found, the input value will be returned unmodified.
'Author: Guido Witt-Dörring
'Source: https://gist.github.com/guwidoe/6f0cbcd22850a360c623f235edd2dce2
Public Function GetWebPath(ByVal path As String, _
                  Optional ByVal rebuildCache As Boolean = False) _
                           As String
    #If Mac Then
        Const vbErrPermissionDenied As Long = 70
        Const vbErrInvalidFormatInResourceFile As Long = 325
        Const ps As String = "/"
    #Else
        Const ps As String = "\"
    #End If
    Const vbErrFileNotFound As Long = 53
    Const vbErrOutOfMemory As Long = 7
    Const vbErrKeyAlreadyExists As Long = 457
    Const chunkOverlap As Long = 1000
    Static locToWebColl As Collection, lastTimeNotFound As Collection
    Static lastCacheUpdate As Date
    Dim webRoot As String, locRoot As String, vItem As Variant
    Dim s As String, keyExists As Boolean

    If path Like "http*" Then GetWebPath = path: Exit Function

    If Not locToWebColl Is Nothing And Not rebuildCache Then
        locRoot = path: GetWebPath = ""
        If locRoot Like "*" & ps Then locRoot = Left(locRoot, Len(locRoot) - 1)
        Do
            On Error Resume Next: locToWebColl locRoot: keyExists = _
            (Err.Number = 0): On Error GoTo -1: On Error GoTo 0
            If keyExists Or InStr(locRoot, ps) = 0 Then Exit Do
            locRoot = Left(locRoot, InStrRev(locRoot, ps) - 1)
        Loop
        If InStr(locRoot, ps) > 0 Then _
            GetWebPath = Replace(Replace(path, locRoot, _
                         locToWebColl(locRoot)(1), , 1), ps, "/"): Exit Function
        If Not lastTimeNotFound Is Nothing Then
            On Error Resume Next: lastTimeNotFound path
            keyExists = (Err.Number = 0): On Error GoTo -1: On Error GoTo 0
            If keyExists Then
                If DateAdd("s", 10, lastTimeNotFound(path)) > Now() Then _
                    GetWebPath = path: Exit Function
            End If
        End If
        GetWebPath = path
    End If

    Dim cid As String, fileNum As Long, line As Variant, parts() As String
    Dim tag As String, mainMount As String, relPath As String, email As String
    Dim b() As Byte, n As Long, i As Long, size As Long, libNr As String
    Dim parentID As String, folderID As String, folderName As String
    Dim folderIdPattern As String, fileName As String, folderType As String
    Dim siteID As String, libID As String, webID As String, lnkID As String
    Dim odFolders As Object, cliPolColl As Object, libNrToWebColl As Object
    Dim sig1 As String: sig1 = StrConv(Chr$(&H2), vbFromUnicode)
    Dim sig2 As String: sig2 = ChrW$(&H1) & String(3, vbNullChar)
    Dim vbNullByte As String: vbNullByte = MidB$(vbNullChar, 1, 1)
    Dim buffSize As Long, lastChunkEndPos As Long, lenDatFile As Long
    Dim lastFileUpdate As Date
    #If Mac Then
        Dim utf16() As Byte, utf32() As Byte, j As Long, k As Long, m As Long
        Dim charCode As Long, lowSurrogate As Long, highSurrogate As Long
        ReDim b(0 To 3): b(0) = &HAB&: b(1) = &HAB&: b(2) = &HAB&: b(3) = &HAB&
        Dim sig3 As String: sig3 = b: sig3 = vbNullChar & vbNullChar & sig3
    #Else
        ReDim b(0 To 1): b(0) = &HAB&: b(1) = &HAB&
        Dim sig3 As String: sig3 = b: sig3 = vbNullChar & sig3
    #End If

    Dim settPath As String, wDir As String, clpPath As String
    #If Mac Then
        s = Environ("HOME")
        settPath = Left(s, InStrRev(s, "/Library/Containers")) & _
                   "Library/Containers/com.microsoft.OneDrive-mac/Data/" & _
                   "Library/Application Support/OneDrive/settings/"
        clpPath = s & "/Library/Application Support/Microsoft/Office/CLP/"
    #Else
        settPath = Environ("LOCALAPPDATA") & "\Microsoft\OneDrive\settings\"
        clpPath = Environ("LOCALAPPDATA") & "\Microsoft\Office\CLP\"
    #End If

    #If Mac Then
        Dim possibleDirs(0 To 11) As String: possibleDirs(0) = settPath
        For i = 1 To 9: possibleDirs(i) = settPath & "Business" & i & ps: Next i
       possibleDirs(10) = settPath & "Personal" & ps: possibleDirs(11) = clpPath
        If Not GrantAccessToMultipleFiles(possibleDirs) Then _
            Err.Raise vbErrPermissionDenied
    #End If

    Dim oneDriveSettDirs As Collection: Set oneDriveSettDirs = New Collection
    Dim dirName As Variant: dirName = Dir(settPath, vbDirectory)
    Do Until dirName = ""
        If dirName = "Personal" Or dirName Like "Business#" Then _
            oneDriveSettDirs.Add dirName
        dirName = Dir(, vbDirectory)
    Loop

    #If Mac Then
        s = ""
        For Each dirName In oneDriveSettDirs
            wDir = settPath & dirName & ps
            cid = IIf(dirName = "Personal", "????????????????", _
                      "????????-????-????-????-????????????")
           If dirName = "Personal" Then s = s & "//" & wDir & "GroupFolders.ini"
            s = s & "//" & wDir & "global.ini"
            fileName = Dir(wDir, vbNormal)
            Do Until fileName = ""
                If fileName Like cid & ".ini" Or _
                   fileName Like cid & ".dat" Or _
                   fileName Like "ClientPolicy*.ini" Then _
                    s = s & "//" & wDir & fileName
                fileName = Dir
            Loop
        Next dirName
        If Not GrantAccessToMultipleFiles(Split(Mid(s, 3), "//")) Then _
            Err.Raise vbErrPermissionDenied
    #End If

    If Not locToWebColl Is Nothing And Not rebuildCache Then
        s = ""
        For Each dirName In oneDriveSettDirs
            wDir = settPath & dirName & ps
            cid = IIf(dirName = "Personal", "????????????????", _
                      "????????-????-????-????-????????????")
            If Dir(wDir & "global.ini") <> "" Then _
                s = s & "//" & wDir & "global.ini"
            fileName = Dir(wDir, vbNormal)
            Do Until fileName = ""
                If fileName Like cid & ".ini" Then _
                    s = s & "//" & wDir & fileName
                fileName = Dir
            Loop
        Next dirName
        For Each vItem In Split(Mid(s, 3), "//")
            If FileDateTime(vItem) > lastCacheUpdate Then _
                rebuildCache = True: Exit For
        Next vItem
        If Not rebuildCache Then
            If lastTimeNotFound Is Nothing Then _
                Set lastTimeNotFound = New Collection
            On Error Resume Next: lastTimeNotFound.Remove path: On Error GoTo 0
            lastTimeNotFound.Add Item:=Now(), Key:=path
            Exit Function
        End If
    End If

    lastCacheUpdate = Now()
    Set lastTimeNotFound = Nothing

    Set locToWebColl = New Collection
    For Each dirName In oneDriveSettDirs
        wDir = settPath & dirName & ps
        If Dir(wDir & "global.ini", vbNormal) = "" Then GoTo NextFolder
        fileNum = FreeFile()
        Open wDir & "global.ini" For Binary Access Read As #fileNum
            ReDim b(0 To LOF(fileNum)): Get fileNum, , b
        Close #fileNum: fileNum = 0
        #If Mac Then
            b = StrConv(b, vbUnicode)
        #End If
        For Each line In Split(b, vbNewLine)
            If line Like "cid = *" Then cid = Mid(line, 7): Exit For
        Next line

        If cid = "" Then GoTo NextFolder
        If (Dir(wDir & cid & ".ini") = "" Or _
            Dir(wDir & cid & ".dat") = "") Then GoTo NextFolder
        If dirName Like "Business#" Then
            folderIdPattern = Replace(Space(32), " ", "[a-f0-9]")
        ElseIf dirName = "Personal" Then
            folderIdPattern = Replace(Space(16), " ", "[A-F0-9]") & "!###*"
        End If

        Set cliPolColl = New Collection
        fileName = Dir(wDir, vbNormal)
        Do Until fileName = ""
            If fileName Like "ClientPolicy*.ini" Then
                fileNum = FreeFile()
                Open wDir & fileName For Binary Access Read As #fileNum
                    ReDim b(0 To LOF(fileNum)): Get fileNum, , b
                Close #fileNum: fileNum = 0
                #If Mac Then
                    b = StrConv(b, vbUnicode)
                #End If
                cliPolColl.Add Key:=fileName, Item:=New Collection
                For Each line In Split(b, vbNewLine)
                    If InStr(1, line, " = ", vbBinaryCompare) Then
                        tag = Left(line, InStr(line, " = ") - 1)
                        s = Mid(line, InStr(line, " = ") + 3)
                        Select Case tag
                        Case "DavUrlNamespace"
                            cliPolColl(fileName).Add Key:=tag, Item:=s
                        Case "SiteID", "IrmLibraryId", "WebID"
                            s = Replace(LCase(s), "-", "")
                            If Len(s) > 3 Then s = Mid(s, 2, Len(s) - 2)
                            cliPolColl(fileName).Add Key:=tag, Item:=s
                        End Select
                    End If
                Next line
            End If
            fileName = Dir
        Loop

        buffSize = -1
Try:    On Error GoTo Catch
        Set odFolders = New Collection
        lastChunkEndPos = 1: i = 0
        lastFileUpdate = FileDateTime(wDir & cid & ".dat")
        Do
            If FileDateTime(wDir & cid & ".dat") > lastFileUpdate Then GoTo Try
            fileNum = FreeFile
            Open wDir & cid & ".dat" For Binary Access Read As #fileNum
                lenDatFile = LOF(fileNum)
                If buffSize = -1 Then buffSize = lenDatFile
                ReDim b(0 To buffSize + chunkOverlap)
                Get fileNum, lastChunkEndPos, b: s = b: size = LenB(s)
            Close #fileNum: fileNum = 0
            lastChunkEndPos = lastChunkEndPos + buffSize

            For vItem = 16 To 8 Step -8
                i = InStrB(vItem + 1, s, sig2)
                Do While i > vItem And i < size - 168
                    If MidB$(s, i - vItem, 1) = sig1 Then
                        i = i + 8: n = InStrB(i, s, vbNullByte) - i
                        If n < 0 Then n = 0
                        If n > 39 Then n = 39
                        folderID = StrConv(MidB$(s, i, n), vbUnicode)
                        i = i + 39: n = InStrB(i, s, vbNullByte) - i
                        If n < 0 Then n = 0
                        If n > 39 Then n = 39
                        parentID = StrConv(MidB$(s, i, n), vbUnicode)
                        i = i + 121: n = -Int(-(InStrB(i, s, sig3) - i) / 2) * 2
                        If n < 0 Then n = 0
                        #If Mac Then
                            utf32 = MidB$(s, i, n)
                            ReDim utf16(LBound(utf32) To UBound(utf32))
                            j = LBound(utf32): k = LBound(utf32)
                            Do While j < UBound(utf32)
                                If utf32(j + 2) = 0 And utf32(j + 3) = 0 Then
                                    utf16(k) = utf32(j)
                                    utf16(k + 1) = utf32(j + 1)
                                    k = k + 2
                                Else
                                    If utf32(j + 3) <> 0 Then Err.Raise _
                                        vbErrInvalidFormatInResourceFile
                                    charCode = utf32(j + 2) * &H10000 + _
                                               utf32(j + 1) * &H100& + utf32(j)
                                    m = charCode - &H10000
                                    highSurrogate = &HD800& + (m \ &H400&)
                                    lowSurrogate = &HDC00& + (m And &H3FF)
                                    utf16(k) = CByte(highSurrogate And &HFF&)
                                    utf16(k + 1) = CByte(highSurrogate \ &H100&)
                                    utf16(k + 2) = CByte(lowSurrogate And &HFF&)
                                    utf16(k + 3) = CByte(lowSurrogate \ &H100&)
                                    k = k + 4
                                End If
                                j = j + 4
                            Loop
                            ReDim Preserve utf16(LBound(utf16) To k - 1)
                            folderName = utf16
                        #Else
                            folderName = MidB$(s, i, n)
                        #End If
                        If folderID Like folderIdPattern Then
                            odFolders.Add VBA.Array(parentID, folderName), _
                                          folderID
                        End If
                    End If
                    i = InStrB(i + 1, s, sig2)
                Loop
                If odFolders.Count > 0 Then Exit For
            Next vItem
        Loop Until lastChunkEndPos >= lenDatFile _
                Or buffSize >= lenDatFile
        GoTo Continue
Catch:
        If Err.Number = vbErrKeyAlreadyExists Then
            odFolders.Remove folderID
            Resume
        End If
        If Err.Number <> vbErrOutOfMemory Then Err.Raise Err
        If buffSize > &HFFFFF Then buffSize = buffSize / 2: Resume Try
        Err.Raise Err
Continue: On Error GoTo 0

        fileNum = FreeFile()
        Open wDir & cid & ".ini" For Binary Access Read As #fileNum
            ReDim b(0 To LOF(fileNum)): Get fileNum, , b
        Close #fileNum: fileNum = 0
        #If Mac Then
            b = StrConv(b, vbUnicode)
        #End If
        Select Case True
        Case dirName Like "Business#"
            mainMount = "": Set libNrToWebColl = New Collection
            For Each line In Split(b, vbNewLine)
                webRoot = "": locRoot = ""
                Select Case Left$(line, InStr(line, " = ") - 1)
                Case "libraryScope"
                    parts = Split(line, """"): locRoot = parts(9)
                    If locRoot = "" Then libNr = Split(line, " ")(2)
                    folderType = parts(3): parts = Split(parts(8), " ")
                    siteID = parts(1): webID = parts(2): libID = parts(3)
                    If mainMount = "" And folderType = "ODB" Then
                        mainMount = locRoot: fileName = "ClientPolicy.ini"
                    Else
                        fileName = "ClientPolicy_" & libID & siteID & ".ini"
                    End If
                    On Error Resume Next
                    webRoot = cliPolColl(fileName)("DavUrlNamespace")
                    On Error GoTo 0
                    If webRoot = "" Then
                        For Each vItem In cliPolColl
                            If vItem("SiteID") = siteID And vItem("WebID") = _
                            webID And vItem("IrmLibraryId") = libID Then
                                webRoot = vItem("DavUrlNamespace"): Exit For
                            End If
                        Next vItem
                    End If
                    If webRoot = "" Then Err.Raise vbErrFileNotFound
                    If locRoot = "" Then
                        libNrToWebColl.Add VBA.Array(libNr, webRoot), libNr
                    Else
                        locToWebColl.Add VBA.Array(locRoot, webRoot, email), _
                                         locRoot
                    End If
                Case "libraryFolder"
                    locRoot = Split(line, """")(1): libNr = Split(line, " ")(3)
                    For Each vItem In libNrToWebColl
                        If vItem(0) = libNr Then
                            s = "": parentID = Left(Split(line, " ")(4), 32)
                            Do
                                On Error Resume Next: odFolders parentID
                                keyExists = (Err.Number = 0): On Error GoTo 0
                                If Not keyExists Then Exit Do
                                s = odFolders(parentID)(1) & "/" & s
                                parentID = odFolders(parentID)(0)
                            Loop
                            webRoot = vItem(1) & s: Exit For
                        End If
                    Next vItem
                    locToWebColl.Add VBA.Array(locRoot, webRoot, email), locRoot
                Case "AddedScope"
                    parts = Split(line, """")
                    relPath = parts(5): If relPath = " " Then relPath = ""
                    parts = Split(parts(4), " "): siteID = parts(1)
                    webID = parts(2): libID = parts(3): lnkID = parts(4)
                    fileName = "ClientPolicy_" & libID & siteID & lnkID & ".ini"
                    On Error Resume Next
                    webRoot = cliPolColl(fileName)("DavUrlNamespace") & relPath
                    On Error GoTo 0
                    If webRoot = "" Then
                        For Each vItem In cliPolColl
                            If vItem("SiteID") = siteID And vItem("WebID") = _
                            webID And vItem("IrmLibraryId") = libID Then
                                webRoot = vItem("DavUrlNamespace") & relPath
                                Exit For
                            End If
                        Next vItem
                    End If
                    If webRoot = "" Then Err.Raise vbErrFileNotFound
                    s = "": parentID = Left(Split(line, " ")(3), 32)
                    Do
                        On Error Resume Next: odFolders parentID
                        keyExists = (Err.Number = 0): On Error GoTo 0
                        If Not keyExists Then Exit Do
                        s = odFolders(parentID)(1) & ps & s
                        parentID = odFolders(parentID)(0)
                    Loop
                    locRoot = mainMount & ps & s
                    locToWebColl.Add VBA.Array(locRoot, webRoot, email), locRoot
                Case Else
                    Exit For
                End Select
            Next line
        Case dirName = "Personal"
            For Each line In Split(b, vbNewLine)
                If line Like "library = *" Then _
                    locRoot = Split(line, """")(3): Exit For
            Next line
            On Error Resume Next
            webRoot = cliPolColl("ClientPolicy.ini")("DavUrlNamespace")
            On Error GoTo 0
            If locRoot = "" Or webRoot = "" Or cid = "" Then GoTo NextFolder
            locToWebColl.Add VBA.Array(locRoot, webRoot & "/" & cid, email), _
                             locRoot
            If Dir(wDir & "GroupFolders.ini") = "" Then GoTo NextFolder
            cid = "": fileNum = FreeFile()
            Open wDir & "GroupFolders.ini" For Binary Access Read As #fileNum
                ReDim b(0 To LOF(fileNum)): Get fileNum, , b
            Close #fileNum: fileNum = 0
            #If Mac Then
                b = StrConv(b, vbUnicode)
            #End If
            For Each line In Split(b, vbNewLine)
                If InStr(line, "BaseUri = ") And cid = "" Then
                    cid = LCase(Mid(line, InStrRev(line, "/") + 1, 16))
                    folderID = Left(line, InStr(line, "_") - 1)
                ElseIf cid <> "" Then
                    locToWebColl.Add VBA.Array(locRoot & ps & odFolders( _
                                     folderID)(1), webRoot & "/" & cid & "/" & _
                                     Mid(line, Len(folderID) + 9), email), _
                                     locRoot & ps & odFolders(folderID)(1)
                    cid = "": folderID = ""
                End If
            Next line
        End Select
NextFolder:
        cid = "": s = "": email = "": Set odFolders = Nothing
    Next dirName

    Dim tmpColl As Collection: Set tmpColl = New Collection
    For Each vItem In locToWebColl
        locRoot = vItem(0): webRoot = vItem(1): email = vItem(2)
       If Right(webRoot, 1) = "/" Then webRoot = Left(webRoot, Len(webRoot) - 1)
        If Right(locRoot, 1) = ps Then locRoot = Left(locRoot, Len(locRoot) - 1)
        tmpColl.Add VBA.Array(locRoot, webRoot, email), locRoot
    Next vItem
    Set locToWebColl = tmpColl

    GetWebPath = GetWebPath(path, False): Exit Function
End Function

您可以轻松地将本地路径转换为相应的 OneDrive URL，方法如下：

'Requires the function GetWebPath! (https://dev59.com/OsTra4cB1Zd3GeqP3U_F#74165973)
Dim oneDriveUrl as String
oneDriveUrl = GetWebPath(yourLocalPath)

你的代码可能长这样：

Sub QrLabelCreate()
    Dim localPath as String
    localPath = "C:Users\Name\OneDrive\MyMap\" & ID & ".pdf"
'STEP 1:
'Excel VBA put data into a word-document, and export it to pdf-file (saved to OneDrive):
        .ActiveDocument.ExportAsFixedFormat _
            OutputFileName:=localPath, _
            ExportFormat:=wdExportFormatPDF
        
'STEP 2: THE PROBLEM
'====== I am not able to create code that gives me the URL to the pdf-file. ==========

'Requires the function GetWebPath! (https://dev59.com/OsTra4cB1Zd3GeqP3U_F#74165973)
    Dim oneDriveUrl as String
    oneDriveUrl = GetWebPath(localPath)

'STEP 3:
'The URL is pasted into the spreadsheet, and  VBA creates the QR-code.

End Sub

我想指出，使用优秀的VBA-FileTools库（@Cristian Buse（GitHub）已经在评论中指出！）也可以实现这一点。如果您导入他的库，您可以像我在这个答案中提供的函数一样将路径转换为URL：

'Requires the library VBA-FileTools! (https://github.com/cristianbuse/VBA-FileTools)
Dim oneDriveUrl as String
oneDriveUrl = GetWebPath(yourLocalPath)