Public Sub CreateFolderPath(ByVal sPath As String)
On Error Resume Next
  Dim i1, i2 As Integer
  i2 = 2  ' path could be absolute (first char \ )

  ' absolute path with drive letter? then search later for \
  If Len(sPath) >= 2 Then
    If Mid$(sPath, 2, 1) = ":" Then i2 = 4
  End If
  
  ' always trailing backslash
  If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
  
  While i2 <= Len(sPath)
    i1 = InStr(i2, sPath, "\", vbTextCompare)
    If i1 > 0 Then
      MkDir Left$(sPath, i1 - 1)
      i2 = i1 + 1
    Else
      i2 = Len(sPath) + 1
    End If
  Wend
End Sub