excel 在OneDrive中创建新文件夹

2sbarzqh 于 2023-01-27 发布在其他

关注(0)|答案(2)|浏览(260)

我已经使用下面的代码很多年了。它创建了一个新文件夹，并将其命名为下一个工作日的日期+在其中添加另一个文件夹，命名为“VO”。代码得到了两个“fPath”行。暂停的是原来的一个。有了这个，我可以移动我的文件，代码仍然会根据ThisWorkbook的位置创建新文件夹。
但是，对于OneDrive，原始“fPath”行以“运行时错误52：错误的文件名或编号””，标记行.CreateFolder (EndDir1)。为什么此代码在OneDrive中不起作用？当我将“fPath”行更改为完整地址时，它工作正常。

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 Sub

excel

来源：https://stackoverflow.com/questions/70606718/create-new-folder-in-onedrive

2条答案

按热度按时间

5q4ezhmt1#

这个来自链接帖子（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

赞(0）回复(0）举报 2023-01-27

kmpatx3s2#

试试这个：
将https：//my ....切换到C：\用户...

Sub Sample()
    GetLocalFile = Split(ThisWorkbook.Path, "/Documents")(2)
    GetLocalFile = Replace(GetLocalFile, "/", "\")
    MyPath = Environ("onedrive") & "\documents" & GetLocalFile
    MkDir (MyPath & "\New")
End Sub

赞(0）回复(0）举报 2023-01-27

我来回答

excel 在OneDrive中创建新文件夹

2条答案

相关问题

热门标签

最新问答