Question

我在OneDrive上有一本工作簿。通常，ThisWorkbook.FullName返回磁盘上的路径：

c:\Users\MyName\OneDrive - MyCompany\BlaBla\MyWorkbook 09-21-17.xlsb

但是在VBA中的一组操作之后，我手动将文件保存到备份文件夹并使用新日期重命名当前文件，OneDrive同步并且ThisWorkbook.FullName返回一个URL：

https://mycompany.sharepoint.com/personal/MyName_Company_com/Documents/mycompany/Apps/BlaBla/MyWorkbook 10-21-17.xlsb

我需要磁盘路径，即使ThisWorkbook.FullName返回一个URL。

如果我想要一起破解某些东西，我可以在操作之前保存路径，但我希望能够随时检索磁盘路径。

我已经看到其他人一起入侵的一些程序like this one，但它或多或少只是将URL重新格式化为磁盘上的路径。这样做并不可靠，因为URL路径和磁盘路径并不总是具有相同的目录结构（请参阅链接过程中重新格式化与上面给出的目录结构相比）。

是否有一种可靠，直接的方式返回工作簿磁盘上的路径，即使它在线同步并且ThisWorkbook.FullName正在返回一个URL？

Answer 1

update daily_item_sales as t set
    (sales_amt, sales_qty, sales_prc, ...) = (s.sales_amt, s.sales_qty, s.sales_prc, ...)
from updated_Item_data as s
where
    t.id = s.id and
    (t.sales_amt, t.sales_qty, t.sales_prc, ...) is distinct from (s.sales_amt, s.sales_qty, s.sales_prc, ...)

Answer 2

我使用Windows环境变量来解决此问题。

在我的示例中，我使用了专用的OneDrive，但是更改代码以处理OneDrive for Business非常简单。这样，环境变量将为“ OneDriveCommercial”，而不是“ OneDriveConsumer”。

这是我用于将OneDrive URL转换为本地路径的代码：

Rem consumer URL to OneDrive root: "https://d.docs.live.net/<64-bit hex value>/"
OneDriveServerURL = "https://d.docs.live.net/"

path = ActiveWorkbook.path
Worksheets("Menu").Range("G6").Value = path

If Left(path, Len(OneDriveServerURL)) = OneDriveServerURL Then
  Rem remove from start to first "/" after server URL
  path = Mid(path, InStr(Len(OneDriveServerURL) + 1, path, "/"))

  Rem replce "/" by "\"
  path = Replace(path, "/", Application.PathSeparator)

  Rem add OneDrive root folder from environment variable
  path = Environ("OneDriveConsumer") + path
End If

Answer 3

这里有一个解决这个问题的方法。 Sharepoint 库到本地挂载点的分配存储在注册表中，以下函数会将 URL 转换为本地文件名。我编辑了这个以纳入 RMK 的建议：

Function GetLocalFile(wb As Workbook) As String
    ' Set default return
    GetLocalFile = wb.FullName

    Const HKEY_CURRENT_USER = &H80000001

    Dim strValue As String

    Dim objReg As Object: Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    Dim strRegPath As String: strRegPath = "Software\SyncEngines\Providers\OneDrive\"
    Dim arrSubKeys() As Variant
    objReg.EnumKey HKEY_CURRENT_USER, strRegPath, arrSubKeys

    Dim varKey As Variant
    For Each varKey In arrSubKeys
        ' check if this key has a value named "UrlNamespace", and save the value to strValue
        objReg.getStringValue HKEY_CURRENT_USER, strRegPath & varKey, "UrlNamespace", strValue

        ' If the namespace is in FullName, then we know we have a URL and need to get the path on disk
        If InStr(wb.FullName, strValue) > 0 Then
            Dim strTemp As String
            Dim strCID As String
            Dim strMountpoint As String
        
            ' Get the mount point for OneDrive
            objReg.getStringValue HKEY_CURRENT_USER, strRegPath & varKey, "MountPoint", strMountpoint
        
            ' Get the CID
            objReg.getStringValue HKEY_CURRENT_USER, strRegPath & varKey, "CID", strCID
        
            ' strip off the namespace and CID
            strTemp = Right(wb.FullName, Len(wb.FullName) - Len(strValue & "/" & strCID))
        
            ' replace all forward slashes with backslashes
            GetLocalFile = strMountpoint & Replace(strTemp, "/", "\")
            Exit Function
        End If
    Next
End Function

Answer 4

这是来自 beerockxs 的更正和重新设计的代码。它在我的机器上工作，但我不确定它在其他设置上的工作情况。如果其他人可以测试，那就太好了。我会在解决方案中标记 beerockxs 的答案。

Function GetLocalFile(wb As Workbook) As String
    ' Set default return
    GetLocalFile = wb.FullName
    
    Const HKEY_CURRENT_USER = &H80000001

    Dim strValue As String
    
    Dim objReg As Object: Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    Dim strRegPath As String: strRegPath = "Software\SyncEngines\Providers\OneDrive\"
    Dim arrSubKeys() As Variant
    objReg.EnumKey HKEY_CURRENT_USER, strRegPath, arrSubKeys
    
    Dim varKey As Variant
    For Each varKey In arrSubKeys
        ' check if this key has a value named "UrlNamespace", and save the value to strValue
        objReg.getStringValue HKEY_CURRENT_USER, strRegPath & varKey, "UrlNamespace", strValue
    
        ' If the namespace is in FullName, then we know we have a URL and need to get the path on disk
        If InStr(wb.FullName, strValue) > 0 Then
            Dim strTemp As String
            Dim strCID As String
            Dim strMountpoint As String
            
            ' Get the mount point for OneDrive
            objReg.getStringValue HKEY_CURRENT_USER, strRegPath & varKey, "MountPoint", strMountpoint
            
            ' Get the CID
            objReg.getStringValue HKEY_CURRENT_USER, strRegPath & varKey, "CID", strCID
            
            ' Add a slash, if the CID returned something
            If strCID <> vbNullString Then
                strCID = "/" & strCID
            End If

            ' strip off the namespace and CID
            strTemp = Right(wb.FullName, Len(wb.FullName) - Len(strValue & strCID))
            
            ' replace all forward slashes with backslashes
            GetLocalFile = strMountpoint & Replace(strTemp, "/", "\")
            Exit Function
        End If
    Next
End Function

Answer 5

如果您有个人 OneDrive，请使用 Environ("OneDriveConsumer")

代码： Environ("OneDriveCommercial")+Replace(Right(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - (InStr(ThisWorkbook.FullName, "/Documents/") + 9)),"/","")

"/Documents/" 应该是标准配置，但您的 OneDrive 可能有不同的设置。如果是这样，您将需要用您拥有的任何内容替换“/Documents/”（OneDrive 前缀的末尾）。并将“9”替换为您所拥有的长度减去 2。

Answer 6

我唯一能想到的是，当您知道拥有它时（在开始保存和同步之前）缓存localPath，然后＆＃34;重建＆＃34;使用缓存的localPath和工作簿Name的路径：

Public Sub Test()
    Dim localPath As String
    With New FileSystemObject

        With .GetFolder(ActiveWorkbook.Path)
            localPath = .Path
        End With

        'SaveAs/synchronize...

        Debug.Print .BuildPath(localPath, ActiveWorkbook.Name)

    End With
End Sub

ThisWorkbook.FullName在与OneDrive同步后返回一个URL。我想要磁盘上的文件路径

6 个答案: