VBA Excel - problem with saving file on newly created folder

Question

I would like to store my files in newly created folders at the same time. Unfortunately, the current code:

 Dim City as Range
 Dim Saverng as Range
 Dim PathName As String
 Dim FolderName As String

 Set Target = ActiveCell

 SelectedRow = Target.Row

 Set City = cstws.Range("L" & SelectedRow)
 Set Saverng = cstws.Range("K" & SelectedRow)

 PathName = ThisWorkbook.path & "\test\"
 FolderName = UCase(City)

 If Dir(PathName & FolderName, vbDirectory) = "" Then
      MkDir PathName & FolderName
 Else
      MsgBox "The folder " & FolderName & " already exists"
 End If

 Set wkb = Workbooks.Add

 With wkb

      .SaveAs filename:=PathName & FolderName & "\" & Saverng & " - Pre-Survey Template V1.1.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled

doesn't allow on it. It keep saying that my directory doesn't exist.

I guess some silly error is here, how can I save files under the newly created directory then?

UPDATE:

My current code looks as follows:

PathName = ThisWorkbook.path & "\test\"
FolderName = UCase(City)

If FolderName = vbNullString Then
     If City = "" Then
          MsgBox ("What is the Site Address City?")
          Exit Sub
     Else
          MkDir (PathName & FolderName)
     End If
Else
     MsgBox ("The Folder " & UCase(City) & " already exists")
End If

Despite the lack of a folder, I get the info, that my folder already exists afterward I am unable to save the file in the directory as shown earlier.

UPDATE II:

Now my code looks like this:

 PathName = Application.ThisWorkbook.path & "\test\"

 FolderName = UCase(City)

  If City = "" Then
    MsgBox ("What is the Site Address City?")
    Exit Sub
  End If

 If Dir(PathName & FolderName, vbDirectory) = "" Then
 MkDir (PathName & FolderName)
 Else
 MsgBox ("The Folder " & UCase(City) & " already exists")
 End If


 Set wkb = Workbooks.Add

 With wkb
    
    .SaveAs filename:=PathName & FolderName & "\" & WAddress & " - Pre-Survey Template V1.1.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled

And the folder is being created, but I get the 1004 error:

Run-time error 1004 The file could not be accessed....

Basically, I can store just one file there, but every other throws an error like the above.

Answer 1

Creating Files and Folders based on Arbitrary Strings

Since your problem is one that often occurs when saving files with names based on strings from a non-path source like the worksheet or other data in general, let me give you an alternative to your workaround, which seems sub-optimal to me.

The link you provide together with your answer suggests, that you just don't save files if a linefeed character exists in the "FileName" string.
This is not only a very brittle fix, because a linefeed is not the only forbidden character for filenames on windows, but also it seems unsatisfying. You would probably still like to save such files.

Wouldn't it be better to just remove the forbidden characters from the input string?

Such a function is easily devised and could look like this for example:

Function RemoveForbiddenFilenameChars(ByVal fileName As String) As String
    Const forbiddenChars As String = "\/:*?""<>|[]" '[ and ] are excel specific
    Dim i As Long, j As Long
    Dim currChar As String

    j = 0
    For i = 1 To Len(fileName)
        currChar = Mid(fileName, i, 1)
        If InStr(forbiddenChars, currChar) = 0 And (AscW(currChar) > 31) Then
            j = j + 1
            Mid(fileName, j, 1) = currChar
        End If
    Next i
    
    RemoveForbiddenFilenameChars = Left(fileName, j)
End Function

This function will remove the forbidden characters \/:*?""<>|[] and the ASCII control characters (these include linefeed and carriage return) from a string.

A similar thing should also be done when adding folders based on user defined strings.

Using this function, your code could be rewritten like this:

Sub exampleSub()
    'These declarations and initialisations are just examples, need to change
    Dim cstws As Worksheet, selectedRow As Long
    Set cstws = ActiveSheet
    selectedRow = ActiveCell.RowIndex
    
    Dim city As String
    Dim address As String
    city = cstws.Range("L" & selectedRow).Value
    address = cstws.Range("K" & selectedRow).Value
    
    Dim path As String
    Dim fileName As String
    Dim folderName As String
    path = ThisWorkbook.path & "\test\"
    folderName = RemoveForbiddenFilenameChars(UCase(city))
    fileName = RemoveForbiddenFilenameChars(address)
    
    If folderName = "" Then MsgBox "No foldername specified!", vbCritical: Exit Sub
    If fileName = "" Then MsgBox "No filename specified!", vbCritical: Exit Sub
    
    If Dir(path & folderName, vbDirectory) = "" Then
        MkDir path & folderName
    Else
        MsgBox "The Folder " & folderName & " already exists"
    End If
    
    Dim wb As Workbook
    Set wb = Workbooks.Add
    wb.SaveAs fileName:=path & folderName & "\" & fileName & _
                        " - Pre-Survey Template V1.1.xlsm", _
              FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub

For your usecase, this is most likely sufficient but it is important to note that there are many rules for file and foldernames on Windows that this can still potentially violate.

One of these would be the maximum path length, another one are forbidden strings as folder / filenames, like "con", "com#", "lpt#", "nul", "prn" or "aux", but there are even more.

Also, your code currently uses "\" as a path separator. If it is intended to work cross-platform this is not always going to work.

Another culprit is that, if your file is stored in a OneDrive synchronized directory, ThisWorkbook.Path will return a URL, which the Dir function can not deal with, even if you would concatenate with "/" as a path separator in that case.
If you plan on working with OneDrive, I recommend using this solution to avoid this problem.

The best way to deal with these complications is using a library like this one for example.

Answer 2

Running your "Update 2" code, I also get an 1004 error when running it for more than just once. It complains because I can not save the new document (wkb = Workbooks.Add) under the same name as another workbook that is currently opened in Excel. Which is the saved one from the round before. All I have to do to solve it, is closing the saved workbook. Change your with block to this:

' If you want to auto-overwrite existing files uncomment the next line:
' Application.DisplayAlerts = False

With wkb
  .SaveAs Filename:=PathName & FolderName & "\" & WAddress & " - Pre-Survey Template V1.1.xlsm", _
  FileFormat:=xlOpenXMLWorkbookMacroEnabled
  .Close
End With

Application.DisplayAlerts = True

Answer 3

I think I've found an error, which honestly could be taken into account by anyone who will read this post because it's a silly thing that might waste your time if you are not savvy enough with these things.

My code was quite correct, but the primary problem was the break line in the cell, from which the address was picked up.

The solution for the workaround is here: https://www.excelcise.org/vba-function-to-check-cell-multiple-lines/

and it can be applied as the condition, in which the occurrence of the line break won't simply execute the code but exit the macro preventing the error from appearing.