Save Excel data into .dat file, including non-English words

Question

The VBA code below, used for saving Excel data into a .dat file, works perfectly for English words but not for non-English.

How you should I modify it to handle non-English words?

Sub Save_Click()
    Dim FileName As String
    Dim wks As Worksheet
    Set wks = ThisWorkbook.Sheets(1)
    Dim rowRange As Range
    Dim colRange As Range
    Dim LastCol As Long
    Dim LastRow As Long
    Dim ColCounter As Integer
    Dim rowCounter As Integer
    Dim metarow As Integer
    Dim mergerow As Integer
    Dim noofmetacolumns As Integer
    Dim j As Integer
    FileName = Application.GetSaveAsFilename
    Open FileName For Output As #1
    LastRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row
    Set rowRange = wks.Range("A1:A" & LastRow)
    'Loop through each row
    rowCounter = 0
    metarow = 0
    mergerow = 0
    noofmetacolumns = 0
    For Each rrow In rowRange
    'Find Last column in current row
    metarow = 0
    mergerow = 0
    rowCounter = rowCounter + 1
    LastCol = wks.Cells(rowCounter, wks.Columns.Count).End(xlToLeft).Column
    Set colRange = wks.Range(wks.Cells(rowCounter, 1), wks.Cells(rowCounter, LastCol))
    'Loop through all cells in row up to last col
        ColCounter = 0
        For Each cell In colRange
                'Do something to each cell
                'Debug.Print (cell.Value)
                If ColCounter <> 0 Then
                   Print #1, "|";
                   Print #1, cell.Value;
                Else
                   Print #1, cell.Value;
                End If

                ColCounter = ColCounter + 1

                If ColCounter = 1 Then
                 If cell.Value = "METADATA" Then
                    metarow = 1
                 End If

                If cell.Value = "MERGE" Then
                    mergerow = 1
                 End If
                End If



            Next cell
        If metarow = 1 Then

          noofmetacolumns = ColCounter

        End If

        If mergerow = 1 Then

            For j = ColCounter + 1 To noofmetacolumns
               Print #1, "|";
            Next j

        End If


        Print #1, vbNewLine;
        Next rrow


        Close #1


    MsgBox ("File Saved Successfully")
    End Sub
    Sub ImportFile()
    Dim Filt As String
    Dim Title As String
    Dim FileName As String
    Filt = "HDL Dat Files (*.dat),*.dat"
    Title = "Select a HDL Dat File to Import"
    FileName = Application.GetOpenFilename(FileFilter:=Filt, Title:=Title)
    'Procedure call. | is defined as separator,
    'and data is to be inserted on "Sheet1".
    copyDataFromHDLDatFileToSheet FileName, "|", "Sheet1"
    Sheets(1).Select
End Sub

Answer 1

test this code.

Sub Save_Click()
    Dim FileName As String
    Dim wks As Worksheet
    Dim rngDB As Range
    Set wks = ThisWorkbook.Sheets(1)

    FileName = Application.GetSaveAsFilename
    Set rngDB = wks.UsedRange
    TransToCSV FileName, rngDB

    MsgBox ("File Saved Successfully")
End Sub
Sub TransToCSV(myfile As String, rng As Range)

    Dim vDB, vR() As String, vTxt()
    Dim i As Long, n As Long, j As Integer
    Dim objStream
    Dim strTxt As String

    Set objStream = CreateObject("ADODB.Stream")
    vDB = rng
    For i = 1 To UBound(vDB, 1)
        n = n + 1
        ReDim vR(1 To UBound(vDB, 2))
        For j = 1 To UBound(vDB, 2)
            vR(j) = vDB(i, j)
        Next j
        ReDim Preserve vTxt(1 To n)
        vTxt(n) = Join(vR, "|")
    Next i
    strTxt = Join(vTxt, vbCrLf)
    With objStream
        .Charset = "utf-8"
        .Open
        .WriteText strTxt
        .SaveToFile myfile, 2
        .Close
    End With
    Set objStream = Nothing

End Sub

Instead Usedrange, use bellow code

Sub Save_Click()
    Dim FileName As String
    Dim wks As Worksheet
    Dim rngDB As Range
    Dim r As Long, c As Long

    Set wks = ThisWorkbook.Sheets(1)

    With wks
        r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        c = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        Set rngDB = .Range("a1", .Cells(r, c))
    End With

    FileName = Application.GetSaveAsFilename

    TransToCSV FileName, rngDB

    MsgBox ("File Saved Successfully")
End Sub

I think you have a no empty cell in your sheet. test this code.

Sub Cellselect()

    Dim FileName As String
    Dim wks As Worksheet
    Dim rngDB As Range
    Dim r As Long, c As Long

    Set wks = ThisWorkbook.Sheets(1)

    With wks
        r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        c = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        .Cells(r, c).Select
    End With

End Sub