I note that the default path is a UNC network file path. In which case you are correct, the version of CreateFolders I posted would not work with such a path. (I wrote it down and still missed it ) Replace the CreateFolders and FolderExists functions with the following. Note the Root network drive must exist.

Public Sub CreateFolders(strPath As String)
'A Graham Mayor/Greg Maxey AddIn Utility Macro
Dim oFSO As Object
Dim lngPathSep As Long
Dim lngPS As Long
  If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
  lngPathSep = InStr(3, strPath, "\")
  If lngPathSep = 0 Then GoTo lbl_Exit
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  Do
    lngPS = lngPathSep
    lngPathSep = InStr(lngPS + 1, strPath, "\")
    If lngPathSep = 0 Then Exit Do
    If Len(Dir(Left(strPath, lngPathSep), vbDirectory)) = 0 Then Exit Do
  Loop
  Do Until lngPathSep = 0
    If Not oFSO.FolderExists(Left(strPath, lngPathSep)) Then
      oFSO.CreateFolder Left(strPath, lngPathSep)
    End If
    lngPS = lngPathSep
    lngPathSep = InStr(lngPS + 1, strPath, "\")
  Loop
lbl_Exit:
  Set oFSO = Nothing
  Exit Sub
End Sub