Excel CSV Formatting Macro

I am trying to export multiple worksheets as an specific csv file with very specific formatting to feed into third party software (PJe Calc Cidadão).

PJe accepts files written in the following format:

"MES_ANO";"VALOR";"FGTS";"FGTS_REC.";"CONTRIBUICAO_SOCIAL";"CONTRIBUICAO_SOCIAL_REC."
"10/2012";"500,00";"S";"S";"S";"S"
"01/2013";"500,00";"S";"N";"S";"N" 

I can achieve this formatting by concatenating formatted values in a single column of a worksheet and saving it as a CSV, but once I open the CSV outside excel it is formated as:

"""MES_ANO"";""VALOR"";""FGTS"";""FGTS_REC."";""CONTRIBUICAO_SOCIAL"";""CONTRIBUICAO_SOCIAL_REC."""
"""12/2015"";""1000,00"";""N"";""N"";""N"";""N"""
"""01/2016"";""1000,00"";""N"";""N"";""N"";""N"""

If I simply copy and paste the column in a txt file I can get the format that I want, but since I need to do that multiple times it's a bit tiring

Any advice?

Upvotes: 0

Views: 208

Answers (1)

CDP1802
CDP1802

Reputation: 16267

Assuming you want to export Columns A to F on all the sheets in the workbook to separate csv files with unicode encoding then try this ;


    Option Explicit

    Sub exportcsv()

        Const LAST_COL = 6
        Const DELIM = ";"
        Const QUOTE = """"

        Dim wb As Workbook, ws As Worksheet
        Dim iRow As Long, iLastRow As Long, s As String, c As Integer, count As Integer
        Dim oFSO As Object, oFS As Object
        Dim sPath As String, sCSVfile As String

        Set oFSO = CreateObject("Scripting.FileSystemObject")
        Set wb = ThisWorkbook
        sPath = wb.path & "\"

        For Each ws In wb.Sheets
            count = 0
            sCSVfile = "Sheet_" & ws.Index & ".csv"
            Set oFS = oFSO.CreateTextFile(sPath & sCSVfile, True, True) 'overwrite, Unicode

            iLastRow = ws.Cells(Rows.count, 1).End(xlUp).Row
            For iRow = 1 To iLastRow
                s = ""
                For c = 1 To LAST_COL
                    If c > 1 Then s = s & DELIM
                    s = s & QUOTE & ws.Cells(iRow, c) & QUOTE
                Next
                oFS.writeline s
                count = count + 1
            Next
            oFS.Close
            Debug.Print sCSVfile, count
        Next
        MsgBox "CSV files exported to " & sPath, vbInformation, "Finished"
    End Sub

Upvotes: 4

Related Questions