Saving specific sheet as CSV UTF-8

Hi,

I currently have this code :

Attaching the file file test.xlsb

Sub btnSaveDataCSV_Click()
    
    Dim csvFileName As String
    Dim fs As FileSystemObject    ' ***** need Microsoft Scripting Runtine Reference
    Dim exportFile As TextStream
    Dim dataSheet As Worksheet
    Dim dataSheetRow As Long
    Dim dataSheetCol As Integer
    Dim lastRow As Long
    Dim lastColumn As Integer
    Dim csvLine As String
    
    ' save the current data on the data sheet to a CSV file
    csvFileName = GetFolder
    If csvFileName = "" Then Exit Sub
    
    csvFileName = csvFileName & "\" & ThisWorkbook.Sheets("Main").Range("C2") & ".csv"
    
    'If MsgBox("Do you want to create " & csvFileName & "?", vbYesNo, "Confirm") = vbNo Then Exit Sub
    Set fs = New FileSystemObject
    
    ' create the file - Should the file be overwritten without warning???
    Set exportFile = fs.CreateTextFile(csvFileName, True)
    Set dataSheet = ThisWorkbook.Sheets("Data")
    
    lastRow = dataSheet.Cells(dataSheet.Rows.Count, 1).End(xlUp).Row
    lastColumn = dataSheet.Cells(1, dataSheet.Columns.Count).End(xlToLeft).Column
    
    ' loop through the rows and columns to create the csv file
    ' ********** assumes there is a header row ******************
    For dataSheetRow = 2 To lastRow
        csvLine = "" ' start a new line of csv to write to the file

        For dataSheetCol = 1 To lastColumn
            csvLine = csvLine & dataSheet.Cells(dataSheetRow, dataSheetCol).Value & ","   ' append each columns data to the line
        Next dataSheetCol
        
        csvLine = Left(csvLine, Len(csvLine) - 1)  ' remove the last comma
        
        exportFile.WriteLine csvLine  ' write it to the file
    Next dataSheetRow
    
    exportFile.Close
    Set exportFile = Nothing
    Set dataSheet = Nothing
    Set fs = Nothing
    
    'MsgBox "The file " & csvFileName & " is created"
    
End Sub

Function GetFolder() As String
    ' display a dialogbox to the user to select where
    ' to save the CSV file
    Dim fldr As FileDialog
    Dim sItem As String
    
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    
    With fldr
        .Title = "Choose a folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With

NextCode:
    GetFolder = sItem
    Set fldr = Nothing

End Function

What it does is save my Data sheet in CSV without the header row (first row). Everything works fine, except that I wish to change it to CSV UTF-8. Unfortunately, as it is currently I am unable to use the file unless I save it manually as CSV UTF-8.

Also this part is optional but it would be nice to have. When I click the button - It opens a dialog box prompting to choose the folder to save the file as. The filename is inside the C2 cell, so it will save as C2value.csv . The second part is fine, because if I want to create a dynamic filepath, I can do that and simply type in the path that I want to use (A2 as an example, but it will be replaced with a formula). However, if I want to create a dynamic filepath, I would like to make to be able to easily remove the dialog box (comment out), because there will be no point in selecting the folder if the path is chosen automatically... I don't like the current implimentation because it doesn't allow me to see files in the folder, only folders.

How can I edit my current code... or I can just replace my current code with something more efficient, to accomplish what I am trying to do ?

Thank you !

Try this code

Option Explicit

Sub btnSaveDataCSV_Click()
    Dim csvFileName As String
    Dim folderPath As String
    Dim dataSheet As Worksheet
    Dim dataSheetRow As Long
    Dim dataSheetCol As Integer
    Dim lastRow As Long
    Dim lastColumn As Integer
    Dim csvLine As String
    Dim stream As Object ' ADODB.Stream

    ' Get folder path and file name from the "Main" sheet
    folderPath = ThisWorkbook.Sheets("Main").Range("A2").Value
    If folderPath = "" Then
        MsgBox "Folder path is empty. Please specify a valid folder path in cell A2.", vbCritical, "Error"
        Exit Sub
    End If

    ' Ensure folder path ends with a backslash
    If Right(folderPath, 1) <> "\" Then
        folderPath = folderPath & "\"
    End If

    ' Set file name from cell C2 in the "Main" sheet
    csvFileName = folderPath & ThisWorkbook.Sheets("Main").Range("C2").Value & ".csv"
    
    ' Check if folder exists
    If Dir(folderPath, vbDirectory) = "" Then
        MsgBox "The specified folder does not exist: " & folderPath, vbCritical, "Error"
        Exit Sub
    End If

    ' Create the ADODB stream for UTF-8 encoding
    Set stream = CreateObject("ADODB.Stream")
    stream.Type = 2 ' Text
    stream.Charset = "UTF-8"
    stream.Open

    ' Get the data from the "Data" sheet
    Set dataSheet = ThisWorkbook.Sheets("Data")
    lastRow = dataSheet.Cells(dataSheet.Rows.Count, 1).End(xlUp).Row
    lastColumn = dataSheet.Cells(1, dataSheet.Columns.Count).End(xlToLeft).Column

    ' Loop through rows and columns to write the CSV content
    For dataSheetRow = 2 To lastRow
        csvLine = "" ' Start a new CSV line

        For dataSheetCol = 1 To lastColumn
            csvLine = csvLine & dataSheet.Cells(dataSheetRow, dataSheetCol).Value & "," ' Add column data
        Next dataSheetCol

        csvLine = Left(csvLine, Len(csvLine) - 1) ' Remove the last comma
        stream.WriteText csvLine & vbCrLf ' Write the line to the stream
    Next dataSheetRow

    ' Save the file
    stream.SaveToFile csvFileName, 2 ' Overwrite if the file already exists
    stream.Close

    ' Clean up
    Set stream = Nothing
    Set dataSheet = Nothing

    MsgBox "File saved successfully as UTF-8: " & csvFileName, vbInformation, "Success"
End Sub

thanks for you repu

Absolutely nothing wrong with sudbhavani's code but since you are using a Table for your data I'd suggest you use the Table Object Properties to determine rows and columns to write csv lines.

Sub btnSaveDataCSV_Click()
    Dim folderPath As String, _
        csvFileName As String, _
        shtObject, _
        dataRow As Long, _
        dataCol As Long, _
        csvLine As String

    ' Get folder path and file name from the "Main" sheet
    folderPath = Range("CITable")
    If folderPath = "" Then
        MsgBox "Folder path is empty. Please specify a valid folder path in cell A2.", vbCritical, "Error"
        Exit Sub
    End If

    ' Ensure folder path ends with a backslash
    If Right(folderPath, 1) <> "\" Then
        folderPath = folderPath & "\"
    End If
    
    ' Check if folder exists
    If Dir(folderPath, vbDirectory) = "" Then
        MsgBox "The specified folder does not exist: " & folderPath, vbCritical, "Error"
        Exit Sub
    End If
    
    ' Set file name from cell C2 in the "Main" sheet
    csvFileName = folderPath & Range("CsvName") & ".csv"
    
    ' Create the ADODB stream for UTF-8 encoding
    With CreateObject("ADODB.Stream")
        .Type = 2 ' Text
        .Charset = "UTF-8"
        .Open

    ' Loop through rows and columns to write the CSV content
        shtObject = Sheets("Data").ListObjects(1).DataBodyRange
        For dataRow = 1 To UBound(shtObject)
            csvLine = "" ' Start a new CSV line
            For dataCol = 1 To UBound(shtObject, 2)
                csvLine = csvLine & shtObject(dataRow, dataCol) & "," ' Add column data
            Next dataCol
            csvLine = Left(csvLine, Len(csvLine) - 1) ' Remove the last comma
            .WriteText csvLine & vbCrLf ' Write the line to the stream
        Next dataRow

    ' Save the file
        .SaveToFile csvFileName, 2 ' Overwrite if the file already exists
        .Close
    End With
    ' Clean up

    MsgBox "File saved successfully as UTF-8: " & csvFileName, vbInformation, "Success"
End Sub