Temat: VBA - eksport do CSV - dodanie kodowania

Sub CopyToCSV()

 Application.ScreenUpdating = False

 

Dim MyPath As String

Dim MyFileName As String

'The path and file names:

MyPath = "..\Desktop"



MyFileName = "export " & Format(Date, "yyyy-mm-dd")

'Makes sure the path name ends with "\":

If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"

'Makes sure the filename ends with ".csv"

If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"

'Copies the sheet to a new workbook:

Sheets("export").Copy

'The new workbook becomes Activeworkbook:



      

With ActiveWorkbook

'Saves the new workbook to given folder / filename:

On Error Resume Next

    .SaveAs Filename:= _

        MyPath & MyFileName, _

        FileFormat:=xlCSVMSDOS, _

        Local:=True, _

        CreateBackup:=False

        

        

'Closes the file

    .Close False

        

End With



End Sub

Link do wypowiedzi

Temat: VBA - eksport do CSV - dodanie kodowania

Link do wypowiedzi

Temat: VBA - eksport do CSV - dodanie kodowania

Link do wypowiedzi

Temat: VBA - eksport do CSV - dodanie kodowania

Link do wypowiedzi

Temat: VBA - eksport do CSV - dodanie kodowania

  FileFormat:=xlCSVMSDOS, _

  FileFormat:=xlCSV, _

Link do wypowiedzi

Temat: VBA - eksport do CSV - dodanie kodowania

Option Explicit



Const strDelimiter = """"

Const strDelimiterEscaped = strDelimiter & strDelimiter

Const strSeparator = ","

Const strRowEnd = vbCrLf

Const strCharset = "utf-8"



Function CsvFormatString(strRaw As String) As String



    Dim boolNeedsDelimiting As Boolean



    boolNeedsDelimiting = InStr(1, strRaw, strDelimiter) > 0 _

        Or InStr(1, strRaw, Chr(10)) > 0 _

        Or InStr(1, strRaw, strSeparator) > 0



    CsvFormatString = strRaw



    If boolNeedsDelimiting Then

        CsvFormatString = strDelimiter & _

            Replace(strRaw, strDelimiter, strDelimiterEscaped) & _

            strDelimiter

    End If



End Function



Function CsvFormatRow(rngRow As Range) As String



    Dim arrCsvRow() As String

    ReDim arrCsvRow(rngRow.Cells.Count - 1)

    Dim rngCell As Range

    Dim lngIndex As Long



    lngIndex = 0



    For Each rngCell In rngRow.Cells

        arrCsvRow(lngIndex) = CsvFormatString(rngCell.Text)

        lngIndex = lngIndex + 1

        

    Next rngCell





    CsvFormatRow = Join(arrCsvRow, ",") & strRowEnd



End Function



Sub CsvExportRange( _

        rngRange As Range, _

        Optional strFileName As Variant _

    )



    Dim rngRow As Range

    Dim objStream As Object



    If IsMissing(strFileName) Or IsEmpty(strFileName) Then

        strFileName = Application.GetSaveAsFilename( _

            InitialFileName:="export " & Format(Date, "yyyy-mm-dd") & ".csv", _

            FileFilter:="CSV (*.csv), *.csv", _

            Title:="Export CSV")

   

            

    End If



    Set objStream = CreateObject("ADODB.Stream")

    objStream.Type = 2

    objStream.Charset = strCharset

    objStream.Open



    For Each rngRow In rngRange.Rows

        objStream.WriteText CsvFormatRow(rngRow)

    Next rngRow



    objStream.SaveToFile strFileName, 2

    objStream.Close



End Sub



Sub CsvExportUTF8()

    CsvExportRange Application.Sheets("export").UsedRange

End Sub



Sub CsvExportSheet(varSheetIndex As Variant)





    Dim wbkExport As Workbook

    Dim shtToExport As Worksheet



Set shtToExport = ThisWorkbook.Worksheets("export")     'Sheet to export as CSV

Set wbkExport = Application.Workbooks.Add



End Sub

Link do wypowiedzi

Temat: VBA - eksport do CSV - dodanie kodowania

  CsvFormatRow = Join(arrCsvRow, ",") & strRowEnd 

  CsvFormatRow = Join(arrCsvRow, ";") & strRowEnd 

Link do wypowiedzi

Temat: VBA - eksport do CSV - dodanie kodowania

objStream.SaveToFile strFileName, 2

    On Error Resume Next

    objStream.SaveToFile strFileName, 1

    If Err.Number = 3004 Then

        MsgBox "File with this name already exists, try to save it with different name"

        CsvExportRange Application.Sheets("export").UsedRange

    End If

Link do wypowiedzi

Temat: VBA - eksport do CSV - dodanie kodowania

Link do wypowiedzi