Export a cell range into a new .csv file with VBA

2019-09-11 06:24发布

问题:

All I am trying to do is copy, paste a cell range into a new CSV file and save the new file with VBA. I will might use this VBA for this file many times. So, I would like to make it save the files with a number.

I am using the code below and it is working:

Sub ExportRangetoFile()
Dim Rng As Range
Dim WorkRng As Range
Dim xFile As Variant
Dim xFileString As String
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ActiveSheet.Copy
Application.ActiveSheet.Cells.Clear
WorkRng.Copy Application.ActiveSheet.Range("A1")
Set xFile = CreateObject("Scripting.FileSystemObject")
ActiveWorkbook.SaveAs Filename:="C:\Users\User\Desktop\Range.csv", FileFormat:=xlCSV, CreateBackup:=False
End Sub

The saved file with the cell range I selected from the original excel file is called Range. I want to change the code and make it save the files without overwriting any other file.

I presume this is the part I should change :

ActiveWorkbook.SaveAs Filename:="C:\Users\User\Desktop\Range.csv", FileFormat:=xlCSV, CreateBackup:=False

I tried to change the "False" to "True" but it did not work. Maybe for another reason though.

回答1:

I just re-read the ? again. What you need is a way to get a new number and add it to the file name.

FiNum = ... 'get file number from a text file
FiName = "C:\Users\User\Desktop\Range" & FiNum & ".csv"
ActiveWorkbook.SaveAs Filename:=FiName, FileFormat:=xlCSV, CreateBackup:=False
FiNum = FiNum + 1
Call WriteToFile(FiNum)  ... 'write file number back to text file

Sub WriteToFile(ByVal FiNum As Long)
    Open "C:\FiNumber.txt" For Output As #1
    Print #1, CStr(FiNum) 'print as string for optimum results
    Close #1
End Sub