在OneDrive中创建新文件夹
在OneDrive中创建新文件夹
提问于 2022-01-06 11:54:18
多年来一直在使用下面的代码。它创建新文件夹，并将其命名为下一个工作日的日期+在其中添加另一个文件夹，名为"VO“。代码有两个"fPath"-lines。暂停的那个是原来的那个。有了这个，我可以移动我的文件，代码仍然将创建新的文件夹，根据ThisWorkbook的位置。
但是，对于OneDrive，原始的"fPath"-line以“运行时错误52:坏文件名或错误号”结尾，标记为.CreateFolder (EndDir1)行。为什么这些代码在OneDrive中不能工作？当我将"fPath"-line转换为完整地址时，它工作得很好。
Sub NewFolderNextWorkDay()
Dim FSO As Object
Dim fsoObj As Object
Dim NeArbDg As Double
NeArbDg = Application.WorkDay(Date, 1)
Dim Dato As String
Dim fPath As String
Dim EndDir1, EndDir2 As String
Dato = Format(NeArbDg, "yyyy-mm-dd")
'fPath = ThisWorkbook.Path & "\..\" '(old code, worked fine until OneDrive came along)
fPath = "C:\Users\MyId\OneDrive - MyJob\Mine dokumenter\PROD\TEST\2022\" '(new code, works ok with OneDrive)
EndDir1 = (fPath & Dato & "\")
EndDir2 = (fPath & Dato & "\VO")
Set fsoObj = CreateObject("Scripting.FileSystemObject")
With fsoObj
If Not .FolderExists(EndDir1) Then
.CreateFolder (EndDir1)
End If
If Not .FolderExists(EndDir2) Then
.CreateFolder (EndDir2)
End If
End With
End SubStack Overflow用户
发布于 2022-01-06 16:56:50
来自链接帖子(https://stackoverflow.com/a/67582367/478884)的这个功能似乎适合我。当strCID没有内容时，我确实需要做一个更改来解决一个问题。见标有####的行
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
If Len(strCID) > 0 Then strValue = strValue & "/" & strCID '#####
strTemp = Right(wb.FullName, Len(wb.FullName) - Len(strValue)) '#####
' replace all forward slashes with backslashes
GetLocalFile = strMountpoint & "\" & Replace(strTemp, "/", "\")
Exit Function
End If
Next
End Function页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/70606718
复制相关文章
相似问题
腾讯云开发者
