Question

我有一个VBA子例程来遍历excel电子表格的行，并将文件从存储在一个单元格中的路径复制到由其他几个单元格的信息组成的路径。很多时候需要为文件创建一个文件夹，但它只有一个级别更深（不要尝试但是，当我运行它时，我有时会遇到运行时错误76 path not found。当我看在Windows资源管理器中的文件夹中，该文件夹出现，但稍微透明（就像正在写入的文件一样）。

为什么我在fso.Createfolder strDirPath遇到此错误？我猜测这与时间有关，因为当我再次运行脚本时，它可以很好地传递文件。有没有办法检查文件夹是否准备好了？

Sub CopyFiles()
  ' Copy to location [root_folder]\company_name\contract_no'_'file_name
  Dim strRootFolder, strCompany, strContract, strFileName, strDirPath
  Dim strFullPath, strFromPath, intRow
  strRootFolder = "C:\...\DestinationFolder\"
  intRow = 2
  Dim fso As New FileSystemObject

  'Loop through rows
  Range("C" & 2).Select 'First row to check (column always filled)
  Do Until IsEmpty(ActiveCell) ' Loop through till end of spreadsheet
      strFromPath = objSheet.Range("C" & intRow).Value
      ' Replace "/" characters in company names with "_"
      strCompany = Replace(objSheet.Range("E" & intRow).Value, "/", "_")
      strContract = objSheet.Range("A" & intRow).Value & "_"
      ' Replace "#" in file names with "0"
      strFileName = Replace(objSheet.Range("B" & intRow).Value, "#", "0")
      strDirPath = strRootFolder & strCompany & "\"
      strFullPath = strDirPath & strContract & strFileName

      ' Create directory if it does not exist
      If Not fso.FolderExists(strDirPath) Then
        fso.Createfolder strDirPath ' !!! This is where the error is !!!
      End If

      ' Copy file
      fso.CopyFile strFromPath, strFullPath, False
    intRow = intRow + 1
    ActiveCell.Offset(1, 0).Select ' drop one  to check if filled
  Loop
End Sub

注意：这不是因为目录名中的反斜杠。代码替换反斜杠，输入中没有正斜杠。

Answer 1

问题是正在创建的目录以空格结尾。在Windows资源管理器中，如果您创建一个末尾有空格的文件夹，它会自动修剪名称。但是，在VBA中，它不会自动完成。

修复方法是在目录名称周围调用Trim()：

  strDirPath = Trim(strRootFolder & strCompany) & "\"

提示：

创建了带尾随空格的文件夹，但会导致Windows出现问题。要重命名或删除它们，您需要使用带有网络路径语法的命令行。（见Rename/Delete Windows (x64) folder with leading and trailing space）

rename "\\?\c:\<PATH HERE>\ 1 " "<NEW FILE NAME>"

在Excel VBA中创建文件夹时找不到路径

1 个答案:

提示：