GetUnshare

Public Function MakeMissingPath(sPath As String) As Boolean
    Dim nCPos As Integer
    Dim nLast As Integer
    Dim sNewPath As String
    
    nCPos = InStr(1, sPath, ":")
    If nCPos <= 0 Then Exit Function
    sNewPath = Left$(sPath, nCPos)
    
    nLast = nCPos
    nCPos = InStr(nLast, sPath, "\")
    If nCPos <= 0 Then Exit Function
    sNewPath = Left$(sPath, nCPos)
    
    Do
    nLast = nCPos + 1
    nCPos = InStr(nLast, sPath, "\")
    If nCPos > 0 Then
        sNewPath = Left$(sPath, nCPos - 1)
        If Not DirExists(sNewPath) Then MkDir sNewPath
    End If
    Loop While nCPos > 0
    If Not DirExists(sPath) Then
        If Right$(sPath, 1) = "\" Then
            MkDir Left$(sPath, Len(sPath) - 1)
        Else
            MkDir sPath
        End If
    End If
    MakeMissingPath = True
End Function

Private Function GetUNCShareName(ByVal sFN As String) As Variant
GetUNCShareName = Null
If IsUNCName(sFN) Then
Dim iFirstSeparator As Integer
iFirstSeparator = InStr(3, sFN, "\")
If iFirstSeparator > 0 Then
Dim iSecondSeparator As Integer
iSecondSeparator = InStr(iFirstSeparator + 1, sFN, "\")
If iSecondSeparator > 0 Then
GetUNCShareName = Left$(sFN, iSecondSeparator - 1)
Else
GetUNCShareName = sFN
End If
End If
End If
End Function

Public Function MakeMissingPath(sPath As String) As Boolean
Dim nCPos As Integer
Dim nLast As Integer
Dim sNewPath As String

nCPos = InStr(1, sPath, ":")
If nCPos <= 0 Then Exit Function
sNewPath = Left$(sPath, nCPos)

nLast = nCPos
nCPos = InStr(nLast, sPath, "\")
If nCPos <= 0 Then Exit Function
sNewPath = Left$(sPath, nCPos)

Do
nLast = nCPos + 1
nCPos = InStr(nLast, sPath, "\")
If nCPos > 0 Then
sNewPath = Left$(sPath, nCPos - 1)
If Not DirExists(sNewPath) Then MkDir sNewPath
End If
Loop While nCPos > 0
If Not DirExists(sPath) Then
If Right$(sPath, 1) = "\" Then
MkDir Left$(sPath, Len(sPath) - 1)
Else
MkDir sPath
End If
End If
MakeMissingPath = True
End Function