excel - “读取”文件名中的汉字

Question

我修改了从 Kutools 找到的这个 vba 代码，它将 XLS 和 XLSX 的文件夹批量转换为 CSV。Kutools 代码的问题在于它无法处理转换具有多张工作表的工作簿。

所以我写了这个修改：

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

我基本上添加了一个循环来循环遍历每个工作簿中的每个工作表，以另存为单独的 CSV 文件。

它工作得非常好，除非源文件名中有中文字符，在这种情况下宏会冻结。

有没有办法让它处理源文件名中的汉字？

先感谢您！

标签： excelvbaexport-to-csvcjk