"read" Chinese Characters in file names

Viewed 297

I modified this vba code I found from Kutools that batch converts a folder of XLS and XLSX to CSVs. The problem with the Kutools code was that it didn't handle converting workbooks with multiple sheets.

So I wrote this modification:

Sub Button1_Click()

Dim xObjWB As Workbook
Dim xObjWS As Worksheet
Dim xStrEFPath As String
Dim xStrEFFile As String
Dim xObjFD As FileDialog
Dim xObjSFD As FileDialog
Dim xStrSPath As String
Dim xStrCSVFName As String
Dim intFileCount As Integer
Dim TargetFN As String

On Error GoTo EndHandler

If MsgBox("This macro will convert all XLS and XLSX files from one folder to CSVs in another folder." & Chr(13) & Chr(13) & _
        "The program will attempt to close all other workbooks before starting the conversion." & Chr(13) & Chr(13) & _
        "This process may take a while. You will be notified when the conversion is finished." & Chr(13) & Chr(13) & _
        "Click OK to continue. . .", vbOKCancel, "Read Carefully!") = vbCancel Then
        GoTo EndHandler
Else
        For Each xObjWB In Workbooks
            If xObjWB.Name <> ThisWorkbook.Name Then
                xObjWB.Close
            End If
        Next
End If

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
On Error Resume Next
    
    
    Set xObjFD = Application.FileDialog(msoFileDialogFolderPicker)
    xObjFD.AllowMultiSelect = False
    xObjFD.Title = "Select a folder which contains Excel files"
    If xObjFD.Show <> -1 Then Exit Sub
    xStrEFPath = xObjFD.SelectedItems(1) & "\"
 
    Set xObjSFD = Application.FileDialog(msoFileDialogFolderPicker)
 
    xObjSFD.AllowMultiSelect = False
    xObjSFD.Title = "Select a folder to locate CSV files"
    If xObjSFD.Show <> -1 Then Exit Sub
    xStrSPath = xObjSFD.SelectedItems(1) & "\"
 
    xStrEFFile = Dir(xStrEFPath & "*.xls*")

    Do While xStrEFFile <> ""
        Set xObjWB = Workbooks.Open(Filename:=xStrEFPath & xStrEFFile)
            xStrCSVFName = xStrSPath & Left(xStrEFFile, InStr(1, xStrEFFile, ".") - 1)
            intFileCount = 0
            TargetFN = ""
                For Each xObjWS In xObjWB.Sheets
                    intFileCount = intFileCount + 1
                    'TargetFN = xStrCSVFName & "_Sheet" & intFileCount & "_" & xObjWS.Name & ".csv"
                    TargetFN = xStrCSVFName & "_Sheet" & intFileCount & ".csv"
                    xObjWS.Copy
                    ActiveWorkbook.SaveAs Filename:=TargetFN, FileFormat:=xlCSV
                    ActiveWorkbook.Close SaveChanges:=False
                Next
        xObjWB.Close SaveChanges:=False
        xStrEFFile = Dir
    Loop

MsgBox "Process Finished!", , ""

EndHandler:
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

I basically added a loop to cycle through each sheet in the in the each workbook to save as separate CSV files.

It works wonderfully, unless there are Chinese characters in the source filenames in which case the macro freezes.

Is there any way to get this to handle Chinese characters in the source filenames?

Thank you in advance!

0 Answers
Related