VBA Excel – 保存文件到新建文件夹时出现问题

huangapple go评论68阅读模式
英文:

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.

VBA Excel – 保存文件到新建文件夹时出现问题

答案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 = &quot;\/:*?&quot;&quot;&lt;&gt;|[]&quot; &#39;[ 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) &gt; 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 \/:*?&quot;&quot;&lt;&gt;|[] 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()
    &#39;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(&quot;L&quot; &amp; selectedRow).Value
    address = cstws.Range(&quot;K&quot; &amp; selectedRow).Value
    
    Dim path As String
    Dim fileName As String
    Dim folderName As String
    path = ThisWorkbook.path &amp; &quot;\test\&quot;
    folderName = RemoveForbiddenFilenameChars(UCase(city))
    fileName = RemoveForbiddenFilenameChars(address)
    
    If folderName = &quot;&quot; Then MsgBox &quot;No foldername specified!&quot;, vbCritical: Exit Sub
    If fileName = &quot;&quot; Then MsgBox &quot;No filename specified!&quot;, vbCritical: Exit Sub
    
    If Dir(path &amp; folderName, vbDirectory) = &quot;&quot; Then
        MkDir path &amp; folderName
    Else
        MsgBox &quot;The Folder &quot; &amp; folderName &amp; &quot; already exists&quot;
    End If
    
    Dim wb As Workbook
    Set wb = Workbooks.Add
    wb.SaveAs fileName:=path &amp; folderName &amp; &quot;\&quot; &amp; fileName &amp; _
                        &quot; - Pre-Survey Template V1.1.xlsm&quot;, _
              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:

&#39; If you want to auto-overwrite existing files uncomment the next line:
&#39; Application.DisplayAlerts = False

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

Application.DisplayAlerts = True

答案3

得分: -1

我认为我已经发现了一个错误,老实说,任何阅读这篇文章的人都可以考虑一下,因为这是一个愚蠢的问题,如果你对这些事情不够精通,可能会浪费你的时间。

VBA Excel – 保存文件到新建文件夹时出现问题

我的代码是相当正确的,但主要问题是单元格中的换行符,从中提取地址。

解决方法是这里:
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.

VBA Excel – 保存文件到新建文件夹时出现问题

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.

huangapple
  • 本文由 发表于 2023年3月9日 23:56:38
  • 转载请务必保留本文链接:https://go.coder-hub.com/75687061.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定