Create new Folder in OneDrive

Question

Been using code below for years. It creates new folder, and names it to next work-day's date + adds another folder within this, named "VO". Code got two "fPath"-lines. The one at pause is the original one. With this one I can move my files around, and code will still create new folder, based on location of ThisWorkbook.

However, with OneDrive, original "fPath"-line ends in "Run-time error 52: Bad file name or number", marking line .CreateFolder (EndDir1). Why doesn't this code work in OneDrive? When I change "fPath"-line into complete address, it works just fine.

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

Have you already created the `2022` folder (it's a relatively new year)? — VBasic2008, Jan 06 '22 at 12:07
Yes. But that's not the issue. The code should (given original fPath-line) create new folder based on the location of ThisWorkbook. Folder-names further into the path should not be relevant..? — kit99, Jan 06 '22 at 12:31
It is relevant. You cannot create the folder `C:\Test1\Test2` if `C:\Test1` doesn't exist (by using `CreaatFolder` or `MkDir`). BTW what is the `ThisWorkbook`'s path in this case? Also, are you sure that `OneDrive - MyJob` is not a folder in the folder `OneDrive`? To get the OneDrive path, you can use `Environ("OneDrive")`. Test this with `Debug.Print Environ("OneDrive")`. — VBasic2008, Jan 06 '22 at 12:46
I'm pretty sure that I've gotten into the same mess described here. :-) https://stackoverflow.com/questions/46346567/thisworkbook-fullname-returns-a-url-after-syncing-with-onedrive-i-want-the-file/67697487#67697487 — kit99, Jan 06 '22 at 13:21

score 1 · Answer 1 · answered Jan 06 '22 at 16:56

This function from the linked post (https://stackoverflow.com/a/67582367/478884) seems to work for me. I did need to make a change to fix an issue when strCID has no content. See lines marked ####

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

For some reason, the property "UrlNamespace" of personal OneDrive mount point registry keys does not end with a `/`, while for business OneDrive mount points it does. To make this solution work for personal OneDrive, you could replace `strMountpoint & "\" & Replace(strTemp, "/", "\")` with `Replace(strMountpoint & "\" & Replace(strTemp, "/", "\"), "\\", "\")`. Also, instead of `Right(wb.FullName, Len(wb.FullName) - Len(strValue))`, you can use the equivalent but shorter `Mid(wb.FullName, Len(strValue) + 1)`. Even with these changes, however, this solution still fails in many cases. — GWD, Sep 05 '22 at 22:53
In fact, writing a solution for this problem that covers all the edge cases is a highly non-trivial task. You might be interested in [this post](https://stackoverflow.com/a/73577057/12287457), which attempts to provide such a function. — GWD, Sep 05 '22 at 22:54

score 1 · Answer 2 · edited Feb 01 '23 at 12:31

1

Change https://my.... to C:\users\...:

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

edited Feb 01 '23 at 12:31

double-beep

5,031
17
33
41

answered Jan 26 '23 at 20:23

Adrian Baran

11
1

Create new Folder in OneDrive

2 Answers2

Linked