如果我想在保存后使用打开的Workbook对象获取Excel文件的全名，但该文件已同步到OneDrive，我会得到一个“https”地址而不是本地地址，其他程序不能解读。
如何获取这样的文件的本地文件名？
例：
将文件保存到“C：\ Users \ user \ OneDrive - Company \ Documents”
OneDrive进行同步
查询Workbook.FullName现在显示为“https：// ...”
答案 0 :(得分：8)
我在网上发现了一个包含足够信息的线程，可以将简单的东西放在一起来解决这个问题。我实际上是用Ruby实现了解决方案，但这是VBA版本：
Option Explicit
Private Function Local_Workbook_Name(ByRef wb As Workbook) 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, wb.FullName, "https://", vbTextCompare) > 0 Then
'Replace forward slashes with back slashes
Local_Workbook_Name = Replace(wb.FullName, "/", "\")
'Get environment path using vbscript
Set objShell = CreateObject("WScript.Shell")
UserProfilePath = objShell.ExpandEnvironmentStrings("%UserProfile%")
'Trim OneDrive designators
For Ctr = 1 To 4
Local_Workbook_Name = Mid(Local_Workbook_Name, InStr(Local_Workbook_Name, "\") + 1)
Next
'Construct the name
Local_Workbook_Name = UserProfilePath & "\OneDrive\" & Local_Workbook_Name
Else
Local_Workbook_Name = wb.FullName
End If
End Function
Private Sub testy()
MsgBox ActiveWorkbook.FullName & vbCrLf & Local_Workbook_Name(ActiveWorkbook)
End Sub
答案 1 :(得分：7)
Horoman的版本（2020-03-30）很好，因为它可在私有和商用OneDrive上使用。但是它崩溃了，因为“ LocalFullName = oneDrivePath＆Application.PathSeparator＆endFilePath”行在oneDrivePath和endFilePath之间插入了一个斜线。此外，应该真正尝试在“ OneDrive”之前尝试“ OneDriveCommercial”和“ OneDriveConsumer”路径。所以这是对我有用的代码：
Sub TestLocalFullName()
Debug.Print "URL: " & ActiveWorkbook.FullName
Debug.Print "Local: " & LocalFullName(ActiveWorkbook.FullName)
Debug.Print "Test: " & Dir(LocalFullName(ActiveWorkbook.FullName))
End Sub
Private Function LocalFullName$(ByVal fullPath$)
'Finds local path for a OneDrive file URL, using environment variables of OneDrive
'Reference https://stackoverflow.com/questions/33734706/excels-fullname-property-with-onedrive
'Authors: Philip Swannell 2019-01-14, MatChrupczalski 2019-05-19, Horoman 2020-03-29, P.G.Schild 2020-04-02
Dim ii&
Dim iPos&
Dim oneDrivePath$
Dim endFilePath$
If Left(fullPath, 8) = "https://" Then 'Possibly a OneDrive URL
If InStr(1, fullPath, "my.sharepoint.com") <> 0 Then 'Commercial OneDrive
'For commercial OneDrive, path looks like "https://companyName-my.sharepoint.com/personal/userName_domain_com/Documents" & file.FullName)
'Find "/Documents" in string and replace everything before the end with OneDrive local path
iPos = InStr(1, fullPath, "/Documents") + Len("/Documents") 'find "/Documents" position in file URL
endFilePath = Mid(fullPath, iPos) 'Get the ending file path without pointer in OneDrive. Include leading "/"
Else 'Personal OneDrive
'For personal OneDrive, path looks like "https://d.docs.live.net/d7bbaa#######1/" & file.FullName
'We can get local file path by replacing "https.." up to the 4th slash, with the OneDrive local path obtained from registry
iPos = 8 'Last slash in https://
For ii = 1 To 2
iPos = InStr(iPos + 1, fullPath, "/") 'find 4th slash
Next ii
endFilePath = Mid(fullPath, iPos) 'Get the ending file path without OneDrive root. Include leading "/"
End If
endFilePath = Replace(endFilePath, "/", Application.PathSeparator) 'Replace forward slashes with back slashes (URL type to Windows type)
For ii = 1 To 3 'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
oneDrivePath = Environ(Choose(ii, "OneDriveCommercial", "OneDriveConsumer", "OneDrive")) 'Check possible local paths. "OneDrive" should be the last one
If 0 < Len(oneDrivePath) Then
LocalFullName = oneDrivePath & endFilePath
Exit Function 'Success (i.e. found the correct Environ parameter)
End If
Next ii
'Possibly raise an error here when attempt to convert to a local file name fails - e.g. for "shared with me" files
LocalFullName = vbNullString
Else
LocalFullName = fullPath
End If
End Function
答案 2 :(得分：6)
我已经调整了其他人提供的函数以考虑一些额外的限制：
当您通过团队网站共享文件时，您应该使用“sharepoint.com/”而不是“my.sharepoint.com/”来确定它是否是商业版本。
最好计算斜线而不是使用“/Documents”的位置，因为例如在法语中，文档文件夹称为“Documents partages”。最好计算 4 个用于商业用途的斜线和 2 个用于个人用途的斜线。
如果作为 OneDrive 快捷方式添加的 SharePoint 文件夹不在根目录下，则硬盘驱动器上的本地地址不包含 SharePoint 上的父文件夹。
以下是将我的更改考虑在内的代码：
Public Function AdresseLocal$(ByVal fullPath$)
'Finds local path for a OneDrive file URL, using environment variables of OneDrive
'Reference https://stackoverflow.com/questions/33734706/excels-fullname-property-with-onedrive
'Authors: Philip Swannell 2019-01-14, MatChrupczalski 2019-05-19, Horoman 2020-03-29, P.G.Schild 2020-04-02
Dim ii&
Dim iPos&
Dim oneDrivePath$
Dim endFilePath$
Dim NbSlash
If Left(fullPath, 8) = "https://" Then
If InStr(1, fullPath, "sharepoint.com/") <> 0 Then 'Commercial OneDrive
NbSlash = 4
Else 'Personal OneDrive
NbSlash = 2
End If
iPos = 8 'Last slash in https://
For ii = 1 To NbSlash
iPos = InStr(iPos + 1, fullPath, "/")
Next ii
endFilePath = Mid(fullPath, iPos)
endFilePath = Replace(endFilePath, "/", Application.PathSeparator)
For ii = 1 To 3
oneDrivePath = Environ(Choose(ii, "OneDriveCommercial", "OneDriveConsumer", "OneDrive"))
If 0 < Len(oneDrivePath) Then Exit For
Next ii
AdresseLocal = oneDrivePath & endFilePath
While Len(Dir(AdresseLocal, vbDirectory)) = 0 And InStr(2, endFilePath, Application.PathSeparator) > 0
endFilePath = Mid(endFilePath, InStr(2, endFilePath, Application.PathSeparator))
AdresseLocal = oneDrivePath & endFilePath
Wend
Else
AdresseLocal = fullPath
End If
End Function
...建立在不同贡献者的工作之上。
答案 3 :(得分：3)
非常有帮助，谢谢。我有一个类似的问题，但是文件夹名称而不是文件名。因此，我对其做了一些修改。我使它适用于文件夹名称和文件名（不必是工作簿）。如果有帮助，代码如下：
Public Function Local_Name(theName As String) As String
Dim i As Integer
Dim objShell As Object
Dim UserProfilePath As String
' Check if it looks like a OneDrive location.
If InStr(1, theName, "https://", vbTextCompare) > 0 Then
' Replace forward slashes with back slashes.
Local_Name = Replace(theName, "/", "\")
'Get environment path using vbscript.
Set objShell = CreateObject("WScript.Shell")
UserProfilePath = objShell.ExpandEnvironmentStrings("%UserProfile%")
' Trim OneDrive designators.
For i = 1 To 4
Local_Name = Mid(Local_Name, InStr(Local_Name, "\") + 1)
Next i
' Construct the name.
Local_Name = UserProfilePath & "\OneDrive\" & Local_Name
Else
' (must already be local).
Local_Name = theName
End If
End Function
答案 4 :(得分：3)
可以改善Virtuoso的答案，以减少（尽管不能消除）该函数返回“错误”文件位置的机会。问题在于工作簿的.FullName可以有各种URL。我知道这三个：
在我的PC上，我可以通过OneDriveConsumer和OneDriveCommercial环境变量获取相关的本地文件夹以映射前两个URL，这些环境变量除了OneDrive环境变量之外还存在，因此下面的代码利用了这些。我不知道可以处理“与我共享”文件，并且下面的代码将返回其https://样式的位置。
Private Function Local_Workbook_Name(ByRef wb As Workbook) As String
Dim i As Long, j As Long
Dim OneDrivePath As String
Dim ShortName As String
'Check if it looks like a OneDrive location
If InStr(1, wb.FullName, "https://", vbTextCompare) > 0 Then
'Replace forward slashes with back slashes
ShortName = Replace(wb.FullName, "/", "\")
'Remove the first four backslashes
For i = 1 To 4
ShortName = Mid(ShortName, InStr(ShortName, "\") + 1)
Next
'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
For j = 1 To 3
OneDrivePath = Environ(Choose(j, "OneDrive", "OneDriveCommercial", "OneDriveConsumer"))
If Len(OneDrivePath) > 0 Then
Local_Workbook_Name = OneDrivePath & "\" & ShortName
If Dir(Local_Workbook_Name) <> "" Then
Exit Function
End If
End If
Next j
'Possibly raise an error here when attempt to convert to a local file name fails - e.g. for "shared with me" files
End If
Local_Workbook_Name = wb.FullName
End Function
不幸的是，如果文件在OneDrive文件夹和OneDrive for Business文件夹中都存在具有相同路径的文件，则代码无法区分它们，并可能返回“错误的一个”。我没有解决办法。
答案 5 :(得分：3)
这真的是很棒的东西。我在某些Windows 10机器上遇到了这个问题，但在其他机器上却没有，它似乎来来往往。我尝试了所有重置OneDrive，更改配置等操作。我尝试至少在我的计算机上起作用的唯一方法是使用Fullname=CurDir和FileName，而不是FullName= activeworkbook.Path和{{1} }。
这返回了没有https内容的完整本地名称，我可以打开我的文件了。
答案 6 :(得分：1)
我和你有同样的问题。 但是我已经解决了这个问题。 首先，我在运行脚本之前关闭OneDrive。
您可以在第一个脚本中将此脚本添加到您的vba /模块中：
Call Shell("cmd.exe /S /C" & "%LOCALAPPDATA%\Microsoft\OneDrive\OneDrive.exe /shutdown")
然后，在vba /模块上的最后一个脚本中，您可以将其插入以激活OneDrive：
Call Shell("cmd.exe /S /C" & "start %LOCALAPPDATA%\Microsoft\OneDrive\OneDrive.exe /background")
我正在该脚本上使用Windows10。
答案 7 :(得分：1)
轻松修复（2019年初）-对于遇到此问题的其他人：
OneDrive>设置> Office： -取消选中“使用Office应用程序同步我打开的Office文件”
这使excel以典型的“ C：\ Users [UserName] \ OneDrive ...”文件格式而不是UNC“ https：\”格式保存文件。
答案 8 :(得分：1)
不同数量的斜杠“ /”可能与OneDrive的不同版本（专用/专业）相关。比较msdn网站上的MatChrupczalski帖子： https://social.msdn.microsoft.com/Forums/en-US/1331519b-1dd1-4aa0-8f4f-0453e1647f57/how-to-get-physical-path-instead-of-url-onedrive?forum=officegeneral
因此，我将该功能调整为以下内容：
Sub TestMySolution()
MsgBox ActiveWorkbook.FullName & vbCrLf & LocalFullName(ActiveWorkbook.FullName)
End Sub
' 29.03.2020 Horoman
' main parts by Philip Swannell 14.01.2019
' combined with parts from MatChrupczalski 19.05.2019
' using environment variables of OneDrive
Private Function LocalFullName(ByVal fullPath As String) As String
Dim i As Long, j As Long
Dim oneDrivePath As String
Dim endFilePath As String
Dim iDocumentsPosition As Integer
'Check if it looks like a OneDrive location
If InStr(1, fullPath, "https://", vbTextCompare) > 0 Then
'for commercial OneDrive file path seems to be like "https://companyName-my.sharepoint.com/personal/userName_domain_com/Documents" & file.FullName)
If InStr(1, fullPath, "my.sharepoint.com") <> 0 Then
'find "/Documents" in string and replace everything before the end with OneDrive local path
iDocumentsPosition = InStr(1, fullPath, "/Documents") + Len("/Documents") 'find "/Documents" position in file URL
endFilePath = Mid(fullPath, iDocumentsPosition) 'get the ending file path without pointer in OneDrive
Else
'for personal onedrive it looks like "https://d.docs.live.net/d7bbaa#######1/" & file.FullName, _
' by replacing "https.." with OneDrive local path obtained from registry we can get local file path
'Remove the first four backslashes
endFilePath = Mid(fullPath, 9) ' removes "https://" and with it two backslashes
For i = 1 To 2
endFilePath = Mid(endFilePath, InStr(endFilePath, "/") + 1)
Next
End If
'Replace forward slashes with back slashes (URL type to Windows type)
endFilePath = Replace(endFilePath, "/", Application.PathSeparator)
'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
For j = 1 To 3
oneDrivePath = Environ(Choose(j, "OneDrive", "OneDriveCommercial", "OneDriveConsumer"))
If Len(oneDrivePath) > 0 Then
LocalFullName = oneDrivePath & Application.PathSeparator & endFilePath
If Dir(LocalFullName) <> "" Then
Exit Function 'that is it - WE GOT IT
End If
End If
Next j
'Possibly raise an error here when attempt to convert to a local file name fails - e.g. for "shared with me" files
LocalFullName = ""
End If
LocalFullName = fullPath
End Function
玩得开心。
答案 9 :(得分：1)
使用 Environ（“ OneDrive”）代替使用变量 ThisWorkbook.Path 。
Option Explicit
'
Function TransferURL(wbkURL As String) As String
' Converts the URL of a OneDrive into a path.
' Returns the path's name.
Dim oFs As Object
Dim oFl As Object
Dim oSubFl As Object
Dim pos As Integer
Dim pathPart As String
Dim oneDrive As String
Dim subFl As String
Set oFs = CreateObject("Scripting.FileSystemObject")
' Check the version of OneDrive.
If VBA.InStr(1, _
VBA.UCase(wbkURL), "MY.SHAREPOINT.COM") = 0 Then
oneDrive = "OneDriveConsumer"
Else
oneDrive = "OneDriveCommercial"
End If
Set oFl = oFs.GetFolder(Environ(oneDrive))
' Iteration over OneDrive's subfolders.
For Each oSubFl In oFl.SUBFOLDERS
subFl = "/" & VBA.Mid(oSubFl.Path, _
VBA.Len(Environ(oneDrive)) + 2) & "/"
' Check if part of the URL.
If VBA.InStr(1, _
wbkURL, subFl) > 0 Then
' Determine the path after OneDrive's folder.
pos = VBA.InStr(1, _
wbkURL, subFl)
pathPart = VBA.Mid(VBA.Replace(wbkURL, "/", _
Application.PathSeparator), pos)
End If
Next
TransferURL = Environ(oneDrive) & pathPart
End Function
通过以下方式调用函数：
' Check if path specification as URL.
If VBA.Left(VBA.UCase(oWbk.Path), _
5) = "HTTPS" Then
' Call ...
pathName = TransferURL(oWbk.Path)
End If
OneDriveConsumer与OneDriveCommercial之间的区别源自：
MatChrupczalski编辑，2019年5月9日，星期四5:45 PM
答案 10 :(得分：1)
Option Explicit
Private coll_Locations As Collection ' using Collection but could just as easily use Dictionary
Public Const HKEY_CURRENT_USER = &H80000001
'
Public Function getOneDrv_PathFor(ByVal sPath As String, Optional ByVal sType As String = "") As String
' convert start of passed in path from URL to Local or vice.versa, (for OneDrive Sync'd folders)
' sType : if starts L(ocal) return local path, if starts U(rl) then return URL Path, else return other mode to that passed in
Dim sPathNature As String
Dim vKey As Variant
Dim Slash As String, Slash2 As String
getOneDrv_PathFor = sPath ' return unchanged if no action required or recognised
sType = UCase(Left(sType, 1))
If sType <> "L" And sType <> "U" Then sType = ""
sPathNature = IIf(Left(sPath, 4) = "http", "U", "L")
If sType <> "" And sType = sPathNature Then Exit Function ' nothing to do
If coll_Locations Is Nothing Then get_Locations
For Each vKey In coll_Locations
If InStr(1, sPath, vKey, vbTextCompare) = 1 Then
Slash = IIf(sPathNature = "U", "/", "\")
Slash2 = IIf(Slash = "/", "\", "/")
getOneDrv_PathFor = coll_Locations(vKey) & Replace(Mid(sPath, Len(vKey) + 1), Slash, Slash2)
Exit For
End If
Next
End Function
Private Sub get_Locations()
' collect possible OneDrive: URL vs Local paths
Dim oWMI As Object
Dim sRegPath As String, arrSubKeys() As Variant, vSubKey As Variant
Dim sServiceEndPointUri As String, sUserFolder As String
Set coll_Locations = New Collection
Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
sRegPath = "Software\Microsoft\OneDrive\Accounts\"
oWMI.EnumKey HKEY_CURRENT_USER, sRegPath, arrSubKeys
For Each vSubKey In arrSubKeys
oWMI.GetStringValue HKEY_CURRENT_USER, sRegPath & vSubKey, "ServiceEndPointUri", sServiceEndPointUri
oWMI.GetStringValue HKEY_CURRENT_USER, sRegPath & vSubKey, "UserFolder", sUserFolder
If sServiceEndPointUri <> "" And sUserFolder <> "" Then
If Right(sServiceEndPointUri, 5) = "/_api" Then sServiceEndPointUri = Left(sServiceEndPointUri, Len(sServiceEndPointUri) - 4) & "Documents/"
sUserFolder = sUserFolder & "\"
coll_Locations.Add Item:=sServiceEndPointUri, Key:=sUserFolder
coll_Locations.Add Item:=sUserFolder, Key:=sServiceEndPointUri
End If
Next
'listOneDrv_Locations
Set oWMI = Nothing
End Sub
Public Sub listOneDrv_Locations()
' to list what's in the collection
Dim vKey As Variant
' Set coll_Locations = Nothing
If coll_Locations Is Nothing Then get_Locations
For Each vKey In coll_Locations
Debug.Print vKey, coll_Locations(vKey)
Next
End Sub
然后获取LocalPath将是 strLocalPath = getOneDrv_PathFor（strCurrentPath，“ Local”）
答案 11 :(得分：1)
你好，我就是这样做的，我通过“SOFTWARE\SyncEngines\Providers\OneDrive”找到了我的路径：
private static string GetLocalPath(string url)
{
try
{
var oneDriveKey = Registry.CurrentUser.OpenSubKey(@"Software\SyncEngines\Providers\OneDrive");
if (oneDriveKey != null)
{
foreach (var subKeyName in oneDriveKey.GetSubKeyNames())
{
var subKey = oneDriveKey.OpenSubKey(subKeyName);
if (subKey != null)
{
var urlNameSpace = subKey.GetValue("UrlNamespace").ToString().Trim('/');
if (url.Contains(urlNameSpace) && subKey.GetValue("MountPoint") is string localLibraryPath)
{
string restOfDocumentPath = url.Substring(urlNameSpace.Length);
restOfDocumentPath = restOfDocumentPath.Replace('/', '\\');
return localLibraryPath + restOfDocumentPath;
}
}
}
}
}
catch (Exception e)
{
Console.WriteLine(e.Message);
}
return string.Empty;
}
答案 12 :(得分：0)
对于Philip Swannell改进了Virtuoso原始答案的小改进，当从路径中删除“ \”的数量大于4 /变化时（根据文件，我发现我需要删除5或6）这些）。菲利普提到的缺点仍然存在。
Private Function Local_Workbook_Name(ByRef wb As Workbook) As String
'returns local wb path or nothing if local path not found
Dim i As Long
Dim OneDrivePath As String
Dim ShortName As String
Dim testWbkPath As String
Dim OneDrivePathFound As Boolean
'Check if it looks like a OneDrive location
If InStr(1, wb.FullName, "https://", vbTextCompare) > 0 Then
'Replace forward slashes with back slashes
ShortName = Replace(wb.FullName, "/", "\")
'Remove the first four backslashes
For i = 1 To 4
ShortName = RemoveTopFolderFromPath(ShortName)
Next
'loop through three OneDrive options
For i = 1 To 3
OneDrivePath = Environ(Choose(i, "OneDrive", "OneDriveCommercial", "OneDriveConsumer"))
If Len(OneDrivePath) > 0 Then
'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
Do While ShortName Like "*\*"
testWbkPath = OneDrivePath & "\" & ShortName
If Not (Dir(testWbkPath)) = vbNullString Then
OneDrivePathFound = True
Exit Do
End If
'remove top folder in path
ShortName = RemoveTopFolderFromPath(ShortName)
Loop
End If
If OneDrivePathFound Then Exit For
Next i
Else
Local_Workbook_Name = wb.FullName
End If
If OneDrivePathFound Then Local_Workbook_Name = testWbkPath
End Function
Function RemoveTopFolderFromPath(ByVal ShortName As String) As String
RemoveTopFolderFromPath = Mid(ShortName, InStr(ShortName, "\") + 1)
End Function
答案 13 :(得分：0)
我猜JK2017的代码中有一个小错误：在这3个版本的OneDrive的每次启动时都必须重新构建“ ShortName”变量。因此，ist必须位于“ For i = 1 To 3”循环中。 我还添加了选择，仅获取路径而不是完整文件名。
select u.ID, u.Columns1, u.values1 into #temptable from ColumnsAsValues s
unpivot
(
values1
for Columns1 in (t1,t2,t3,t4)
) u;
SELECT DISTINCT MC2.ID,
(
SELECT STUFF((SELECT ',' + MC1.Columns1 AS [text()]
FROM #temptable MC1
WHERE MC1.ID = MC2.ID and values1=1
ORDER BY MC1.ID
FOR XML PATH (''),type).value('.', 'NVARCHAR(MAX)'),1,1,'')
) [ColumnsWith1]
INTO #CommaSeparatedString
FROM #temptable MC2
select * from
( select id , [ColumnsWith1] from
#CommaSeparatedString ) datatable pivot (max(ColumnsWith1) for id in ([1],[2],[3]))piv;
答案 14 :(得分：0)
我知道这个问题是用 VBA 标记的，但是我在尝试用 C# 解决时发现了这个问题。我写了一个类似于@TWMIC 答案的版本如下：
string LocalPath( string fullPath )
{
if ( fullPath.StartsWith( "https://", StringComparison.InvariantCultureIgnoreCase ) )
{
// So Documents/ location works below
fullPath = fullPath.Replace( "\\", "/" );
var userAccounts = Microsoft.Win32.Registry.CurrentUser
.OpenSubKey(@"Software\Microsoft\OneDrive\Accounts\");
if (userAccounts != null)
{
foreach (var accountName in userAccounts.GetSubKeyNames())
{
var account = userAccounts.OpenSubKey(accountName);
var endPoint = account.GetValue("ServiceEndPointUri") as string;
var userFolder = account.GetValue("UserFolder") as string;
if (!string.IsNullOrEmpty(endPoint) && !string.IsNullOrEmpty(userFolder))
{
if (endPoint.EndsWith("/_api"))
{
endPoint = endPoint.Substring(0, endPoint.Length - 4) + "documents/";
}
if (fullPath.StartsWith(endPoint, StringComparison.InvariantCultureIgnoreCase))
{
return Path.Combine(userFolder, fullPath.Substring(endPoint.Length));
}
}
}
}
}
return fullPath;
}
答案 15 :(得分：-1)
称我为黑客，但我机器上的 http 引用始终相同，因此我查看了可以找到 OneDrive 的硬盘驱动器上的本地引用
假设是 C:\MyOneDrive\OneDrive 然后将不需要的工作簿路径的所有其他部分添加到本地部分。然后切换斜线方向
folder = "C:\MyOneDrive\OneDrive" & Right(Application.ActiveWorkbook.Path, Len(Application.ActiveWorkbook.Path) - 72) & "\"
folder = Replace(folder, "/", "\")
我的两行覆盖了我机器上的所有情况！！