![](/img/trans.png)
[英]How do I get my VBA project reference to an Excel Workbook on OneDrive to use the local drive path rather than the OneDrve URL Path?
[英]How to get the path+filename of an excel workbook stored in my local OneDrive folder? (as opposed to its URL!)
我有一个 excel 工作簿,它本地存储在我的 PC 上,但在我的OneDrive同步文件夹中。 每当我尝试时(从立即的 window 以及以编程方式):
? Excel.Application.ThisWorkbook.FullName
我得到类似的东西:
https://d.docs.live.net/c31ceb5b47a36fa2/VBA/learnVBAmacros.xlsb
而我文件的真实本地路径是:
C:\用户\viset\OneDrive\VBA\learnVBAmacros.xlsb
如何检索我工作簿的后一个本地路径,而不是 OneDrive 上的 URL?
拆分文件名并为本地 OneDrive 文件夹使用环境变量。
dim fn as string
fn = ThisWorkbook.FullName
'split off the workbook name if fullname is a url
fn = split(fn, "/")(ubound(split(fn, "/")))
'split off the workbook name if fullname is a local path
fn = Split(fn, "\")(UBound(Split(fn, "\")))
'add the environment var
fn = environ("onedrive") & "\" & fn
'check to see if it exists
if len(dir(fn)) > 0 then
debug.print fn
end if
请注意,有 OneDrive 和 OneDriveConsumer 环境变量。 我自己的都是相同的,但每个人都必须有一个原因。
这有效,抱歉,但我不记得我在哪里找到的
Sub GetDocLocalPath_Test()
MsgBox GetDocLocalPath(ThisWorkbook.FullName)
End Sub
Function GetDocLocalPath(docPath As String) As String
'Gel Local Path NOT URL to Onedrive
Const strcOneDrivePart As String = "https://d.docs.live.net/"
Dim strRetVal As String, bytSlashPos As Byte
strRetVal = docPath & "\"
If Left(LCase(docPath), Len(strcOneDrivePart)) = strcOneDrivePart Then 'yep, it's the OneDrive path
'locate and remove the "remote part"
bytSlashPos = InStr(Len(strcOneDrivePart) + 1, strRetVal, "/")
strRetVal = Mid(docPath, bytSlashPos)
'read the "local part" from the registry and concatenate
strRetVal = RegKeyRead("HKEY_CURRENT_USER\Environment\OneDrive") & strRetVal
strRetVal = Replace(strRetVal, "/", "\") 'slashes in the right direction
strRetVal = Replace(strRetVal, "%20", " ") 'a space is a space once more
End If
GetDocLocalPath = strRetVal
End Function
Function RegKeyRead(i_RegKey As String) As String
Dim myWS As Object
On Error Resume Next
'access Windows scripting
Set myWS = CreateObject("WScript.Shell")
'read key from registry
RegKeyRead = myWS.RegRead(i_RegKey)
End Function
结合一些早期的答案,我使用了这个功能。 它对 OneDrive URL 格式的假设较少,它使用环境而不是注册表。
注意:它仍然对 OneDrive URL 做出假设。 具体来说:
Function GetWorkbookDirectory() As String
Dim sPath As String
Dim sOneDrive As String
Dim iPos As Integer
sPath = Application.ActiveWorkbook.Path
' Is this a OneDrive path?
If Left(sPath, 6) = "https:" Then
' Find the start of the "local part" of the name
iPos = InStr(sPath, "//") ' Find start of URL hostname
iPos = InStr(iPos + 2, sPath, "/") ' Find end of URL hostname
iPos = InStr(iPos + 1, sPath, "/") ' Find start of local part
' Join that with the local location for OneDrive files
sPath = Environ("OneDrive") & Mid(sPath, iPos)
sPath = Replace(sPath, "/", Application.PathSeparator)
End If
GetWorkbookDirectory = sPath
End Function
我使用 FileSystemObject 解决了这个问题。
Dim fso as FileSystemObject, localPath as String, localFullFileName as String
localPath = fso.GetParentFolderName(fso.GetAbsolutePathName(Application.ActiveWorkbook.Name))
localFullFileName = fso.GetAbsolutePathName(Application.ActiveWorkbook.Name)
只需转到您的一个驱动器设置并取消选中“使用办公应用程序同步....”
我使用 CurDir 解决了这个问题
Function GetFilePath() As String
GetFilePath = CurDir
End Function
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.