保存原件副本时另存为错误

Question

我想知道是否有人可以帮助我.

使用我在网上找到的脚本作为"基础"我在下面写了下面的查询.

Sub Test()
  Dim wb As Workbook
  Dim ThisSheet As Worksheet
  Dim NumOfColumns As Integer
  Dim RangeToCopy As Range
  Dim RangeOfHeader As Range    'data (range) of header row
  Dim WorkbookCounter As Integer
  Dim RowsInFile           'how many rows (incl. header) in new files?
  Dim fNameAndPath As Variant


  fNameAndPath = Application.GetOpenFilename(Title:="Select File To Be Opened")
  If fNameAndPath = False Then Exit Sub
  Workbooks.Open Filename:=fNameAndPath


  Application.ScreenUpdating = False

  'Initialize data
  Set ThisSheet = ActiveWorkbook.Worksheets(1)
  NumOfColumns = ThisSheet.UsedRange.Columns.Count
  WorkbookCounter = 1
  RowsInFile = 50    'as your example, just 1000 rows per file

  'Copy the data of the first row (header)
  Set RangeOfHeader = ThisSheet.Range(ThisSheet.Cells(1, 1), ThisSheet.Cells(1, NumOfColumns))


  For p = 2 To ThisSheet.UsedRange.Rows.Count Step RowsInFile - 1
    Set wb = Workbooks.Add

  'Paste the header row in new file
    RangeOfHeader.Copy wb.Sheets(1).Range("A1")

  'Paste the chunk of rows for this file
    Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p + RowsInFile - 2, NumOfColumns))
    RangeToCopy.Copy wb.Sheets(1).Range("A2")

  'Save the new workbook, and close it

  Application.ScreenUpdating = False

  With wb
    .SaveAs Filename:=fNameAndPath & "\File " & WorkbookCounter, FileFormat:=xlCSV
    wb.Close False
    Application.DisplayAlerts = True
 End With

  'Increment file counter
    WorkbookCounter = WorkbookCounter + 1
  Next p

  Application.ScreenUpdating = True
  Set wb = Nothing
End Sub

脚本的目的是获取"主"文件并拆分为较小的文件,将它们保存为CSV.

With wb
    .SaveAs Filename:=fNameAndPath & "\File " & WorkbookCounter, FileFormat:=xlCSV
    wb.Close False
    Application.DisplayAlerts = True
 End With

我要做的是创建使用原始文件名保存新创建的文件作为新创建的文件名的一部分然后关闭所有文件.

有些人可能会对我出错的地方提供一些指导吗？

非常感谢和亲切的问候

克里斯

Answer 1

.SaveAs Filename:=fNameAndPath & "\File " & WorkbookCounter, FileFormat:=xlCSV
'                                ^^^

这看起来像是一个无效的名称，因为fNameAndPath已经是 Excel 文件的路径和名称，类似于C:\Folder\something.csv，所以它不可能是文件夹。您想\在保存的文件名中添加 吗？

如果您想要在刚刚打开的 csv 文件的同一文件夹中创建不同的文件，则可以使用_（下划线或操作系统在文件名中可接受的任何其他字符）。所以你可以尝试：

.SaveAs Filename:=fNameAndPath & "_File " & WorkbookCounter, FileFormat:=xlCSV
'                                ^^^

编辑

在更好地了解您的需求之后，关于您想要实现的文件命名和拆分，我重构了您的代码。

"File x.csv"基本上我在添加名称之前删除文件的扩展名。我还删除了Copy/Paste有利于分配值的内容（这应该会更快），因为您正在生成 acsv所以您不需要任何格式，只需要值。代码中的一些注释进一步限定了该方法。

Sub SplitWorksheet()
  Dim rowsPerFile As Long: rowsPerFile = 50 ' <-- Set to appropriate number

  Dim fNameAndPath
  fNameAndPath = Application.GetOpenFilename(Title:="Select File To split")
  If fNameAndPath = False Then Exit Sub
  Dim wbToSplit As Workbook: Set wbToSplit = Workbooks.Open(Filename:=fNameAndPath)

  Application.ScreenUpdating = False: Application.DisplayAlerts = False
  On Error GoTo Cleanup

  Dim sheetToSplit As Worksheet: Set sheetToSplit = wbToSplit.Worksheets(1)
  Dim numOfColumns As Long: numOfColumns = sheetToSplit.UsedRange.Columns.Count
  Dim wbCounter As Long: wbCounter = 1 ' auto-increment for file names

  Dim rngHeader As Range, rngToCopy As Range, newWb As Workbook, p  As Long
  Set rngHeader = sheetToSplit.Range("A1").Resize(1, numOfColumns) ' header row

  For p = 2 To sheetToSplit.UsedRange.Rows.Count Step rowsPerFile - 1
    ' Get a chunk for each new workbook
    Set rngToCopy = sheetToSplit.Cells(p, 1).Resize(rowsPerFile - 1, numOfColumns)
    Set newWb = Workbooks.Add
    ' copy header and chunk
    newWb.Sheets(1).Range("A1").Resize(1, numOfColumns).Value = rngHeader.Value
    newWb.Sheets(1).Range("A2").Resize(rowsPerFile - 1, numOfColumns).Value = rngToCopy.Value2

    ' Save the new workbook with new name then close it
    ' Remove extension from original name then add "_File x.csv"
    Dim newFileName As String
    newFileName = Left(fNameAndPath, InStrRev(fNameAndPath, ".") - 1)
    newFileName = newFileName & "_File " & wbCounter & ".csv"

    newWb.SaveAs Filename:=newFileName, FileFormat:=xlCSV
    newWb.Close False
    wbCounter = wbCounter + 1
  Next p

Cleanup:
  If Err.Number <> 0 Then MsgBox Err.Description
  If Not wbToSplit Is Nothing Then wbToSplit.Close False
  Application.ScreenUpdating = True: Application.DisplayAlerts = True
End Sub