excel文件保存成CSV

Sub CsvOutput()
    Dim strNow As String

    Dim csvFile As String
    Dim lastRow As String
    Dim targetRange As Range
    Dim wb As Workbook
    Dim fso As Object
    
    
    strNow = Format(Now, "yyyymmddhhnnss")
    csvFile = Application.GetSaveAsFilename(InitialFileName:="XXXXXXCSV_" & strNow & ".csv", FileFilter:="CSV文件(*.csv),*.csv")
    
    If csvFile <> "False" Then
    
        '最后一行的取得
        lastRow = Cells(Rows.Count, 2).End(xlUp).Row
        
        'CSV文件范围
        Set targetRange = Worksheets(1).Range(Cells(2, 1), Cells(lastRow, 29))
        
        '新建workbook
        Set wb = Workbooks.Add
    
        'CSV文件范围拷贝到新workbook
        targetRange.Copy wb.Worksheets(1).Range("A1")
       
       'cell内改行删除
        wb.Worksheets(1).UsedRange.Replace vbLf, ""
        wb.Worksheets(1).UsedRange.Replace vbCr, ""
        wb.Worksheets(1).UsedRange.Replace vbCrLf, ""
    
        Set fso = CreateObject("Scripting.FileSystemObject")
    
        '输出的CSV文件存在先删除
        If fso.FileExists(csvFile) Then
          fso.deleteFile csvFile
        End If

        '新workbook作为CSV文件输出
        wb.SaveAs Filename:=csvFile, FileFormat:=xlCSVUTF8, Local:=True
    
    
        '新workbook不保存关闭
        wb.Close SaveChanges:=False
    
        MsgBox csvFile & "文件已经输出。"
    
        Set fso = Nothing

    End If

End Sub

你可能感兴趣的:(VBA)