สอบถามการส่งออกไฟล์เป็น .CSV UTF-8

[tigerwit]

จากไฟล์ที่แนบและโค๊ด

Code: Select all

Sub ExpGPAToCSV()
    Dim wb As Worksheet
    Dim myCSVFileName As String
    Dim myWB As Workbook
    Dim tempWB As Workbook
    Dim rngToSave As Range
    
    Dim sFolderPath As String
    Dim Path As String
    Dim FName As String
    On Error Resume Next

    sFolderPath = "C:\" & Range("A16").Value
    If Dir(sFolderPath, vbDirectory) = "" Then
        MkDir sFolderPath
    End If
    
    sFolderPath = "C:\" & Range("A16").Value & "\" & Range("A17").Value
    If Dir(sFolderPath, vbDirectory) = "" Then
        MkDir sFolderPath
    End If
    
    sFolderPath = "C:\" & Range("A16").Value & "\" & Range("A17").Value & "\" & "CSV"
    If Dir(sFolderPath, vbDirectory) = "" Then
        MkDir sFolderPath
    End If
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error GoTo err
    FName = ActiveSheet.Range("A20") & ActiveSheet.Range("A17") & ".csv"

    If MsgBox("คุณต้องการส่งออกผลการเรียน ใช่หรือไม่ ?", 36, "ยืนยันการส่งออกผลการเรียน") = 6 Then
    Set myWB = ThisWorkbook
    Set rngToSave = Range("AU5:BO50")
    rngToSave.Copy
    Set tempWB = Application.Workbooks.Add(1)
    With tempWB
        .Sheets(1).Range("A1").PasteSpecial xlPasteValues
Application.DisplayAlerts = False
.SaveAs Filename:=sFolderPath & "\" & FName, FileFormat:=xlCSV, CreateBackup:=False, local:=True
 .Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "ส่งออกไฟล์ไปไว้ที " & "C:\" & Range("a16").Value & "\" & Range("a17").Value & "\" & FName

    End With
err:
    End If
        Application.DisplayAlerts = True
        Range("F6").Select
End Sub

ไฟล์ที่ส่งออกตามโค๊ดนี้ เป็น .CSV UTF-8 หรือไม่ครับ ถ้าไม่เป็น UTF-8
จะเพิ่ม Code อย่างไรให้เป็น UTF-8

[snasui]

ลองตรวจสอบไฟล์ผลลัพธ์โดยเปิดด้วย Notepad แล้วตรวจสอบตามภาพครับ

[tigerwit]

ได้แล้วครับ
ขอบคุณครับ