vba Save as csv changes japanese characters to question marks

detriez

Board Regular
Joined
Sep 13, 2011
Messages
139
Office Version
  1. 365
Platform
  1. Windows
I am using this code in my .xlsm file to save the file as a CSV UTF-8 file

This works great for English characters but, it replaces non-Latin characters with a series of question marks

I can save this properly by using Save As > CSV UTF-8 Comma Delimited file

What can I be missing here?

VBA Code:
Sub SaveFileAs(Control As IRibbonControl)

Dim fPth As Object
Set fPth = Application.FileDialog(msoFileDialogSaveAs)
Application.DisplayAlerts = False
    With fPth
      .InitialFileName = "SaveNewFile"
      .Title = "Save Prepped File"
      .FilterIndex = 2
      .InitialView = msoFileDialogViewList
            If .Show <> 0 Then
              ThisWorkbook.SaveAs FileName:=.SelectedItems(1), FileFormat:=xlOpenXMLWorkbook
            End If
    End With
Application.DisplayAlerts = True

End Sub
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

Dan_W

Active Member
Joined
Jul 11, 2018
Messages
409
Office Version
  1. 365
Platform
  1. Windows
Hi. Looking at your code, it seems that regardless of what you/the user may select in the Save As dialog box, it will, in any event, be saved in [B]xlOpenXMLWorkbook [/B]and not as CSV:

VBA Code:
ThisWorkbook.SaveAs FileName:=.SelectedItems(1), FileFormat:=xlOpenXMLWorkbook

That gives a FileFormat number of 51, whereas CSV UTF8 is 62. Try changing xlOpenXMLWorkbook in the line above to xlCSVUTF8
 

Dan_W

Active Member
Joined
Jul 11, 2018
Messages
409
Office Version
  1. 365
Platform
  1. Windows
But also, before you run that code, I would just point out that you've referenced the workbook to be saved as CSV as being ThisWorkbook - meaning, the one which contains the very code you're trying run. If you save a macro-containing workbook as a CSV, you will strip it of all it's code. Is that what you want to happen?
 

detriez

Board Regular
Joined
Sep 13, 2011
Messages
139
Office Version
  1. 365
Platform
  1. Windows
Hi Dan.. I appreciate the response
This is a single use template file. We start fresh with a new macro workbook every time so, yes, ThisWorkbook is fine.. Unless you think it may be somehow interfering with the saving on f the csv UTF 8 formatting

I made the suggested change but still getting the question marks
I noticed the .FilterIndex changes from 16 to 2 after I run the code

VBA Code:
Sub SaveFileAs(Control As IRibbonControl)

Dim fPth As Object
Set fPth = Application.FileDialog(msoFileDialogSaveAs)
Application.DisplayAlerts = False
    With fPth
      .InitialFileName = "SaveNewFile"
      .Title = "Save Prepped File"
      .FilterIndex = 2
      .InitialView = msoFileDialogViewList
            If .Show <> 0 Then
              ThisWorkbook.SaveAs FileName:=.SelectedItems(1), FileFormat:=xlCSVUTF8
            End If
    End With
Application.DisplayAlerts = True

End Sub
 

Dan_W

Active Member
Joined
Jul 11, 2018
Messages
409
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Hi
1. No, I don't think that the template issue is affecting the Japanese language encoding.
2. The .FilterIndex property changes to 2 because your code expressly directs it to:
VBA Code:
.FilterIndex = 2
I would point out that the Filter Index for CSV UTF8 is 5.
3. In terms of the encoding, it's been a while since I lived in Japan and haven't had an occasion recently to delve back into the various encoding systems, but is UTF8 the correct one? All I can remember is that whenever I was presented with Mojibake, to try and convert it into Shift-JIS...
 

detriez

Board Regular
Joined
Sep 13, 2011
Messages
139
Office Version
  1. 365
Platform
  1. Windows
Some searching led me to this ..
It works but, I'm not sure how to incorporate the Save as dialog box instead of hard coding the path

Code:
Sub macro_01()
Const myDelim As String = ","
Dim WS As Worksheet

Set WS = ActiveSheet  '<<< convert data from active sheet
Dim r As Long, c As Long, i As Long, j As Long
r = WS.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
c = WS.Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Dim myPath As String
myPath = ThisWorkbook.Path
Dim myFile As String
myFile = myPath & "\new File.csv"
Dim obj As Object
Set obj = CreateObject("ADODB.Stream")
obj.Type = 2
obj.Charset = "unicode"
'obj.Charset = "shift-jis"

''obj.Charset = "utf-8"
obj.Open
Dim v() As Variant
ReDim v(1 To c)
For i = 1 To r
For j = 1 To c
v(j) = WS.Cells(i, j)
Next
obj.WriteText Join(v, myDelim), 1
Next
obj.SaveToFile myFile, 2
obj.Close
Application.ScreenUpdating = False
Dim wb As Workbook
Set wb = Workbooks.Open(myFile)
Dim t As Long, x As Long
t = 1
Do
vv = Split(Cells(t, "A"), myDelim)
For x = 0 To UBound(vv)
Cells(t, x + 1) = vv(x)
Next
t = t + 1
Loop Until Cells(t, "A") = ""
Application.DisplayAlerts = False
wb.Save
wb.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "file is ready"
End Sub
 

Dan_W

Active Member
Joined
Jul 11, 2018
Messages
409
Office Version
  1. 365
Platform
  1. Windows
Hi, that's great that you've worked out how to do it. I'll make a note of it in case I ever find myself having to save a CSV with Japanese in it (which is entirely likely!).

So I've updated your code to:
  • Keep the original SaveFileAs subroutine - I see that this is connected to the ribbon. This now calls the new macro_01 sub.
  • The macro_01 sub now calls a new function GetSaveAsFilename, which is the code that you and I worked on above. It returns the filename, which is preset with a filterindex of 5 to CSV UTF-8 (though that doesn't really mean much given that you're using ADODB (unicode) to save the file). You may wish to put it back to filterindex 16 ...
  • I removed the MyPath variable, because it doesn't appear to be of use anymore.
  • I added a small check to make sure that the filename that came back was not blank - if it is, then it will exit the sub. You may want to consider adding some additional error handling routines in here. For example, what do you want it to do if the file already exists?
  • Also, I changed the last part of your code:
VBA Code:
Application.DisplayAlerts = False
    wb.Save
    wb.Close
    Application.DisplayAlerts = True

I deleted the DisplayAlerts lines because it appears as though what you're trying to stop is the 'do you want save the file' confirmation dialog box - if that's the case, then this can be dealt with by adding a FALSE after the .Close line, so it now reads:
VBA Code:
wb.Save
wb.Close False

The FALSE flag tells VBA that you don't want to save the file again... because your code has just done it - thereby avoiding the dialog box.
I wonder if there might be another issue with the code, but it's hard to say without recreating the workbook and settings involved. Anyway, I'll leave it to you to decide what you think about the changes I've proposed. The full code is below:

VBA Code:
Sub SaveFileAs(Control As IRibbonControl)
    macro_01
End Sub
Sub macro_01()
   
    Const myDelim   As String = ","
   
    Dim WS          As Worksheet
   
    Set WS = ActiveSheet        '<<< convert data from active sheet
   
    Dim r           As Long, c As Long, i As Long, j As Long
   
    r = WS.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    c = WS.Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
   
    Dim myFile      As String
    myFile = GetSaveAsFilename
    If myFile = vbNullString Then
        ' If the user presses cancel then this will exit the subroutine.
        Exit Sub
    End If
   
    Dim obj         As Object
    Set obj = CreateObject("ADODB.Stream")
   
    obj.Type = 2
    obj.Charset = "unicode"
   
    'obj.Charset = "shift-jis"
    ''obj.Charset = "utf-8"
    obj.Open
    Dim v()         As Variant
    ReDim v(1 To c)
    For i = 1 To r
        For j = 1 To c
            v(j) = WS.Cells(i, j)
        Next
        obj.WriteText Join(v, myDelim), 1
    Next
    obj.SaveToFile myFile, 2
    obj.Close
    Application.ScreenUpdating = False
   
    Dim wb          As Workbook
    Set wb = Workbooks.Open(myFile)
   
    Dim t           As Long, x As Long
    t = 1
    Do
        vv = Split(Cells(t, "A"), myDelim)
        For x = 0 To UBound(vv)
            Cells(t, x + 1) = vv(x)
        Next
        t = t + 1
    Loop Until Cells(t, "A") = ""

    wb.Save
    wb.Close False
   
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "file Is ready"
End Sub
Function GetSaveAsFilename() As String
    Dim fPth As Object
    Set fPth = Application.FileDialog(msoFileDialogSaveAs)
   
    With fPth
        .InitialFileName = "SaveNewFile"
        .Title = "Save Prepped File"
        .FilterIndex = 5
        .InitialView = msoFileDialogViewList
        If .Show <> 0 Then
                GetSaveAsFilename = .SelectedItems(1)
        End If
    End With
End Function
 
Solution

detriez

Board Regular
Joined
Sep 13, 2011
Messages
139
Office Version
  1. 365
Platform
  1. Windows
This is great.. Appreciate the help.
I hope you and others can benefit from this
 

Watch MrExcel Video

Forum statistics

Threads
1,129,299
Messages
5,635,387
Members
416,856
Latest member
silentir

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top