VBA将Excel导出为CSV文件

Sub csv()
    Dim Fs, myFile As Object
    Dim myfileline As String 'txtfile的行数据
    Dim sht As Worksheet
    Dim csvFileName As String 'csv文件名
    Dim totalRows As Integer ' 总的行数
    Dim totalColumns As Integer '总的列数
    Dim sheetNumber As Integer '工作表号
    Dim strAll As String '整个工作表的文本
    
    csvFileName = InputBox("请输入文件名:", "CSV", "export_csv")
    totalRows = 17 ' 总的行数
    totalColumns = 10 '总的列数
    sheetNumber = 1 '工作表号
   
    For Each sht In ThisWorkbook.Sheets
       
        Set Fs = CreateObject("Scripting.FileSystemObject")   '建立filesytemobject
        Set myFile = Fs.createtextfile(ActiveWorkbook.Path & "\" + csvFileName & "_Sheet" + CStr(sheetNumber) + ".csv") '通过filesystemobject新建一个csv文件
        
        For i = 1 To totalRows  '从第1行开始
            ra = CStr(sht.Cells(i, 1).Value)    '从第一列开始
            If ra = "" Then Exit For
            rb = ""
            For j = 1 To 10
                ca = CStr(sht.Cells(1, j).Value)
                If ca = "" Then Exit For
                If rb = "" Then
                    rb = CStr(sht.Cells(i, j).Value)
                Else
                    rb = rb & "," & CStr(sht.Cells(i, j).Value)
                End If
            Next j
            myFile.writeline (rb)
            strAll = strAll + rb + vbCrLf
            
        Next i
        Set myFile = Nothing
        Set Fs = Nothing                   '关闭文件和filesystemobject对象
         
         SaveSetting AppName:="MyApp201912", Section:="MySection", Key:="Sheet" & CStr(sheetNumber), Setting:=strAll '保存所有文本到注册表
         
         sheetNumber = sheetNumber + 1 '下一个工作表
         
    Next
    
    MsgBox ("已保存了" + CStr(sheetNumber - 1) + "个CSV文件!")
    
    MsgBox "已保存工作表内容到注册表:HKEY_CURRENT_USER\Software\VB and VBA Program Settings\MyApp201912\MySection"
End Sub

 

你可能感兴趣的:(VBA,excel,csv,vba)