Create folders and sub folders on a network drive vs a mapped drive

Question

I am trying to set up a VBA that checks for existing and then creates standardised project folders based on inputs into a user form. I have it working fully but only on the mapped drive address rather than the network address. When i Have the network address set up I get an error:

Run-time error '52':

Bad file name or number

Here is my code:

'-------- CREATE FOLDERS --------'
Dim strPath  As String
Dim lCtr     As Long
Dim FilePath As String
Dim FileName As String

FilePath = \\Net.work\file\path\Parent\
FileName = Child

'Create INPUTs'
strPath = FilePath & FileName & "\INPUTS"

arrpath = Split(strPath, "\")
strPath = arrpath(LBound(arrpath)) & "\"

    For lCtr = LBound(arrpath) + 1 To UBound(arrpath)
        strPath = strPath & arrpath(lCtr) & "\"
        If Dir(strPath, vbDirectory) = "" Then
            MkDir strPath
        End If
    Next

Whereas if FilePath is R:\Parent\ then it runs fine, only issue is I have a few users and no guarantee it will be mapped to R for everyone.

Answer 1

This works for me: it steps backwards over the path until it hits an existing folder, then goes forward and creates the path from that point.

Sub Tester()
    EnsureFolderPath "\\yourServer\folderA\folderB\ABC\DEF\GHI\KLM"
End Sub


Sub EnsureFolderPath(ByVal folderPath As String)
    
    Dim pth As String, parts As New Collection, pos As Long, f As String
    Dim i As Long
    
    pth = folderPath
    If Right(pth, 1) <> "\" Then pth = pth & "\" 'ensure ending "\"
    
    Do While Not FolderExists(pth)
        pos = InStrRev(pth, "\", Len(pth) - 1) 'find 2nd to last "\" in path
        If pos = 0 Then 'something is wrong with the supplied path...
            MsgBox "Path? " & vbLf & folderPath
            Exit Sub
        End If
        parts.Add Right(pth, Len(pth) - pos) 'save component to create later
        pth = Left(pth, pos) 'remove the saved part
    Loop
    If parts.Count > 0 Then 'any folders to create?
        For i = parts.Count To 1 Step -1 'looping from last to first
            pth = pth & parts(i)
            Debug.Print "Creating: " & pth
            MkDir pth
        Next i
    End If
End Sub

'does `p` refer to an existing folder?
Function FolderExists(p As String) As Boolean
    On Error Resume Next
    FolderExists = ((GetAttr(p) And vbDirectory) = vbDirectory)
End Function