英文:
VBA Excel - problem with saving file on newly created folder
问题
无法访问该文件...基本上,我只能存储一个文件,但每个文件夹之后都会抛出上述错误。
无法访问该文件...基本上,我只能存储一个文件,但每个文件夹之后都会抛出上述错误。
英文:
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.
答案1
得分: 2
基于任意字符串创建文件和文件夹
由于您的问题通常在将文件保存时使用非路径来源(例如工作表或其他数据)的字符串命名时出现,让我为您提供一个替代方案,而不是您看起来不太理想的解决方法。
您提供的链接和答案表明,如果“FileName
”字符串中存在换行符,则不保存文件。
这不仅是一个非常脆弱的修复方式,因为换行符不是Windows文件名的唯一禁止字符,而且似乎并不令人满意。您可能仍然希望保存这样的文件。
从输入字符串中删除禁止字符会不会更好呢?
这样的函数很容易设计,例如可以像这样:
Function RemoveForbiddenFilenameChars(ByVal fileName As String) As String
Const forbiddenChars As String = "\/:*?""<>|[]" '[ 和 ] 是Excel特定的
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
此函数将从字符串中删除禁止字符 \/:*?""<>|[]
和ASCII控制字符(其中包括换行符和回车符)。
当根据用户定义的字符串添加文件夹时,也应该执行类似的操作。
使用这个函数,您的代码可以重写为:
Sub exampleSub()
'这些声明和初始化仅供示例,需要更改
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 "未指定文件夹名!", vbCritical: Exit Sub
If fileName = "" Then MsgBox "未指定文件名!", vbCritical: Exit Sub
If Dir(path & folderName, vbDirectory) = "" Then
MkDir path & folderName
Else
MsgBox "文件夹 " & folderName & " 已经存在"
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
对于您的用例,这可能足够了,但重要的是要注意,Windows上有许多文件和文件夹名称的规则,这仍然有可能违反其中的某些规则。
其中之一是最大路径长度,另一个是禁止字符串作为文件夹/文件名,比如 "con"、"com#"、"lpt#"、"nul"、"prn" 或 "aux",但实际上还有更多。
此外,您的代码目前将 "\" 作为路径分隔符。如果打算跨平台使用,这并不总是适用。
另一个问题是,如果您的文件存储在OneDrive同步目录中,ThisWorkbook.Path
将返回一个URL,而Dir
函数无法处理这个URL,即使在这种情况下使用"/"作为路径分隔符也是如此。
如果计划使用OneDrive,我建议使用 这个解决方案 以避免这个问题。
处理这些复杂情况的最佳方法是使用类似这个的库。
英文:
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](https://github.com/cristianbuse/VBA-FileTools "Cristian Buse - VBA-FileTools") for example.
答案2
得分: 0
运行您的“Update 2”代码时,如果运行超过一次,我也会遇到1004错误。它报错是因为我不能将新文档(wkb = Workbooks.Add
)保存为与Excel中当前已打开的另一个工作簿相同的名称。这个工作簿是上一轮保存的。我只需要关闭已保存的工作簿就可以解决问题。将您的with
块更改为以下内容:
' 如果要自动覆盖现有文件,请取消下一行的注释:
' Application.DisplayAlerts = False
With wkb
.SaveAs Filename:=PathName & FolderName & "\" & WAddress & " - Pre-Survey Template V1.1.xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
.Close
End With
Application.DisplayAlerts = True
英文:
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
答案3
得分: -1
我认为我已经发现了一个错误,老实说,任何阅读这篇文章的人都可以考虑一下,因为这是一个愚蠢的问题,如果你对这些事情不够精通,可能会浪费你的时间。
我的代码是相当正确的,但主要问题是单元格中的换行符,从中提取地址。
解决方法是这里:
https://www.excelcise.org/vba-function-to-check-cell-multiple-lines/
可以将其应用为条件,如果出现换行符,不仅执行代码,而且退出宏,以防止错误出现。
英文:
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.
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论