VBA Document.Path 在 OneDrive 中返回 Web 路径 - 需要本地路径答案

【问题标题】：VBA Document.Path returns Web path when in OneDrive - Need local pathVBA Document.Path 在 OneDrive 中返回 Web 路径 - 需要本地路径
【发布时间】：2021-10-03 15:14:34
【问题描述】：

我正在尝试获取打开文档的本地文件路径。当我使用路径功能时，如果文档在我的 OneDrive 文件夹中，我会得到一个 Web 路径。我认为问题在于该文件存在于两个地方： C:\Users\myloginname\OneDrive\Documents\Project\Samples 和 https://d.docs.live.net/xxxxxxxxxxxx/Documents/Project/Samples

当我尝试将 Dir 函数与网络“路径”一起使用时，我收到错误 52“错误的文件名或编号”。

如何获取本地路径？

【问题讨论】：

相关：stackoverflow.com/questions/33734706/…
谢谢蒂姆。什么线！在我看来，这是 Document 对象的一个缺失属性。所有建议的解决方案都是丑陋的解决方法。（但我肯定会使用一个）
从一个支持大量 excel 宏的人的角度来看，一群人正在慢慢将文件迁移到 Sharepoint，这绝对是一个令人头疼的问题......

标签： vba directory path onedrive word

【解决方案1】：

我最终使用了它，因为我只想要文件夹路径。此外，在使用硬编码文本时，它是一种选择你的毒药，但我担心“.live.net”可能会改变。当然，“\OneDrive\”也可以，这样就可以了。

Private Function Local_Workbook_Path(ByRef doc As Document) As String

  Dim Ctr As Long
  Dim objShell As Object
  Dim UserProfilePath As String
  'Check if it looks like a OneDrive location
  If InStr(1, doc.path, "https://", vbTextCompare) > 0 Then

    'Replace forward slashes with back slashes
    Local_Workbook_Path = Replace(doc.path, "/", "\")

    'Get environment path using vbscript
    Set objShell = CreateObject("WScript.Shell")
    UserProfilePath = objShell.ExpandEnvironmentStrings("%UserProfile%")

      'Trim OneDrive designators
    For Ctr = 1 To 4
       Local_Workbook_Path = Mid(Local_Workbook_Path, InStr(Local_Workbook_Path, "\") + 1)
    Next

      'Construct the name
    Local_Workbook_Path = UserProfilePath & "\OneDrive\" & Local_Workbook_Path
    Local_Workbook_Path = Replace(Local_Workbook_Path, "%20", " ")
  Else

    Local_Workbook_Path = doc.path

  End If

End Function

【讨论】：

【解决方案2】：

下面的函数将返回作为参数提供给它的 FullName 的本地名称。

Function LocalFullName(ByVal Ffn As String) As String
    ' 294

    ' this is part of the URL address before the file's code name
    ' e.g. https://d.docs.live.net/2abce27df5c02e2f/ ....
    Const DriveID   As String = ".live.net"
    
    Dim Fun()       As String           ' function return value
    Dim n           As Integer          ' index of Fun
    Dim Sp()        As String           ' split array of Ffn
    Dim i           As Integer          ' loop counter: index of Sp
    
    Sp = Split(Ffn, "/")
    For i = 1 To UBound(Sp)
        If InStr(1, Sp(i), DriveID, vbTextCompare) Then Exit For
    Next i
    
    If i > UBound(Sp) Then
        LocalFullName = Ffn
    Else
        ReDim Fun(1 To UBound(Sp))
        For i = i + 2 To UBound(Sp)
            n = n + 1
            Fun(n) = Sp(i)
        Next i
        ReDim Preserve Fun(1 To n)
        LocalFullName = Join(Fun, Application.PathSeparator)
    End If
End Function

如果您需要使用名称保存驱动器必须添加。下面的截图展示了如何调用该函数并添加驱动器号。

Sub Snippet()
    ' 294
    
    Const DriveID   As String = "D:\"
    Dim Wb          As Workbook
    
    Set Wb = ThisWorkbook
    Debug.Print DriveID & LocalFullName(Wb.FullName)
End Sub

【讨论】：