Snasui Excel Forum

คลังคำตอบแห่งความรู้จากคนไทย เพื่อโลกที่ต้องการเข้าใจในสิ่งเล็ก ๆ อย่างลึกซึ้ง
https://www.snasui.com/

รบกวนสอบถามการแสดงผลจาก VBA แปลงเป็น xml ไฟล์ แต่ไม่ขึ้นภาษาไทย

https://www.snasui.com/viewtopic.php?t=18930

Page 1 of 1

รบกวนสอบถามการแสดงผลจาก VBA แปลงเป็น xml ไฟล์ แต่ไม่ขึ้นภาษาไทย

Posted: Wed Feb 09, 2022 10:29 am
by sutima
รบกวนสอบถามการตั้งค่า หรือการเขียนโค้ด VBA ค่ะ เนื่องจากไม่แสดงผลเป็นภาษาไทย
เช่น ลองเปลี่ยนข้อมูลในตารางเป็นคำว่า "ไทย" แต่แสดงผลเป็น "xE4xB7xC2"

Re: รบกวนสอบถามการแสดงผลจาก VBA แปลงเป็น xml ไฟล์ แต่ไม่ขึ้นภาษาไทย

Posted: Wed Feb 09, 2022 10:48 am
by logic
สอบถามโค้ด vba ช่วยอ่านกฎข้อ 4, 5 ข้างบนก่อนครับ ⬆

Re: รบกวนสอบถามการแสดงผลจาก VBA แปลงเป็น xml ไฟล์ แต่ไม่ขึ้นภาษาไทย

Posted: Wed Feb 09, 2022 11:22 am
by sutima

Code: Select all


Option Explicit

Sub ExportXML()
Dim outPATH As String, LR As Long, Rw As Long, fNAME As String, Str As String

outPATH = ThisWorkbook.Path & "\XML\"
On Error Resume Next
MkDir outPATH
On Error GoTo 0

LR = Range("A" & Rows.Count).End(xlUp).Row
For Rw = 2 To LR
    fNAME = Trim(Cells(Rw, "M").Value) & ".xml"
    Str = ""
    Open outPATH & fNAME For Output As 1
        Str = "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbLf
        Str = Str & "<Call xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"">" & vbLf
        Str = Str & "  <Data>" & vbLf & "    <set_aud>" & vbLf & "      <connection>" & vbLf
        Str = Str & "        <messagetype>" & Cells(Rw, "A").Value & "</messagetype>" & vbLf
        Str = Str & "        <order>" & Cells(Rw, "B").Value & "</order>" & vbLf
        Str = Str & "        <storage>" & Cells(Rw, "C").Value & "</storage>" & vbLf
        Str = Str & "        <time_stamp>" & Cells(Rw, "D").Value & "</time_stamp>" & vbLf
        Str = Str & "      </connection>" & vbLf & "    </set_aud>" & vbLf
        Str = Str & "    <interaction>" & Cells(Rw, "E").Value & "</interaction>" & vbLf
        Str = Str & "    <dir>" & Cells(Rw, "F").Value & "</dir>" & vbLf
        Str = Str & "    <hold>" & Cells(Rw, "G").Value & "</hold>" & vbLf
        Str = Str & "    <conference>" & Cells(Rw, "H").Value & "</conference>" & vbLf
        Str = Str & "    <duration>" & Format(Cells(Rw, "I").Value, "hh:mm:ss") & "</duration>" & vbLf
        Str = Str & "    <extension>" & Cells(Rw, "J").Value & "</extension>" & vbLf
        Str = Str & "    <offset>" & Cells(Rw, "K").Value & "</offset>" & vbLf
        Str = Str & "    <login>" & Cells(Rw, "L").Value & "</login>" & vbLf
        Str = Str & "    <agent_name>" & Cells(Rw, "M").Value & "</agent_name>" & vbLf
        Str = Str & "    <group_name>" & Cells(Rw, "N").Value & "</group_name>" & vbLf
        Str = Str & "    <ani>" & Cells(Rw, "O").Value & "</ani>" & vbLf
        Str = Str & "    <dnis>" & Cells(Rw, "P").Value & "</dnis>" & vbLf
        Str = Str & "    <ani1>" & Cells(Rw, "Q").Value & "</ani1>" & vbLf
        Str = Str & "  </Data>" & vbLf & "  <Other>" & vbLf
        Str = Str & "    <c02>" & Cells(Rw, "R").Value & "</c02>" & vbLf
        Str = Str & "    <c03>" & Cells(Rw, "S").Value & "</c03>" & vbLf
        Str = Str & "    <c01>" & Cells(Rw, "T").Value & "</c01>" & vbLf
        Str = Str & "    <c04>" & Cells(Rw, "U").Value & "</c04>" & vbLf
        Str = Str & "    <c05>" & Cells(Rw, "V").Value & "</c05>" & vbLf
        Str = Str & "    <c06>" & Cells(Rw, "W").Value & "</c06>" & vbLf
        Str = Str & "    <c07>" & IIf(Cells(Rw, "X") > 0, Cells(Rw, "X").Value, "") & "</c07>" & vbLf
        Str = Str & "    <c08>" & IIf(Cells(Rw, "Y") > 0, Cells(Rw, "Y").Value, "") & "</c08>" & vbLf
        Str = Str & "    <c09>" & IIf(Cells(Rw, "Z") > 0, Cells(Rw, "Z").Value, "") & "</c09>" & vbLf
        Str = Str & "    <c10>" & IIf(Cells(Rw, "AA") > 0, Cells(Rw, "AA").Value, "") & "</c10>" & vbLf
        Str = Str & "    <c11>" & IIf(Cells(Rw, "AB") > 0, Cells(Rw, "AB").Value, "") & "</c11>" & vbLf
        Str = Str & "    <c12>" & IIf(Cells(Rw, "AC") > 0, Cells(Rw, "AC").Value, "") & "</c12>" & vbLf
        Str = Str & "    <c13>" & IIf(Cells(Rw, "AD") > 0, Cells(Rw, "AD").Value, "") & "</c13>" & vbLf
        Str = Str & "    <c14>" & IIf(Cells(Rw, "AE") > 0, Cells(Rw, "AE").Value, "") & "</c14>" & vbLf
        Str = Str & "    <c15>" & IIf(Cells(Rw, "AF") > 0, Cells(Rw, "AF").Value, "") & "</c15>" & vbLf
        Str = Str & "    <c16>" & IIf(Cells(Rw, "AG") > 0, Cells(Rw, "AG").Value, "") & "</c16>" & vbLf
        Str = Str & "  </Other>" & vbLf & "</Call>" & vbLf
        Print #1, Str
    Close #1
Next Rw

End Sub

Re: รบกวนสอบถามการแสดงผลจาก VBA แปลงเป็น xml ไฟล์ แต่ไม่ขึ้นภาษาไทย

Posted: Wed Feb 09, 2022 2:12 pm
by sutima
ไม่แน่ใจว่าทำถูกต้องตามกฎแล้วรึยังคะ รบกวนผู้รู้แนะนำการแก้ปัญหาด้วยค่ะ พอดีติดมาหลายวันแล้ว ขอบพระคุณมากเลยนะคะ

Re: รบกวนสอบถามการแสดงผลจาก VBA แปลงเป็น xml ไฟล์ แต่ไม่ขึ้นภาษาไทย

Posted: Wed Feb 09, 2022 2:42 pm
by sutima
ขออนุญาตชี้แจ้งวัตถุประสงค์การสร้าง VBA นะคะ
พอดีต้องการแยกไฟล์ excel แต่ละ row เป็น 1 ไฟล์ xml ค่ะ ลองค้นหาวิธีการตามเว็บต่างๆ เลยไปเจอไฟล์จากเว็บบอร์ดต่างประเทศที่เค้าทำมาให้แล้วเสร็จ แล้วโพสลงในเว็บบอร์ดค่ะ จึงนำมาประยุกต์กับไฟล์ตัวเองค่ะ แต่ติดตรงที่เวลาแสดงผล ไม่ขึ้นเป็นภาษาไทยค่ะ

Re: รบกวนสอบถามการแสดงผลจาก VBA แปลงเป็น xml ไฟล์ แต่ไม่ขึ้นภาษาไทย

Posted: Wed Feb 09, 2022 4:29 pm
by snasui
:D ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub ExportXML()
    Dim outPATH As String, LR As Long, Rw As Long, fNAME As String, Str As String
    Dim xmlDoc As Object
    
    outPATH = ThisWorkbook.Path & "\XML\"
    On Error Resume Next
    MkDir outPATH
    On Error GoTo 0
    
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")
    LR = Range("A" & Rows.Count).End(xlUp).Row
    For Rw = 2 To LR
        fNAME = Trim(Cells(Rw, "M").Value) & ".xml"
        Str = ""
    '    Open outPATH & fNAME For Output As 1
            Str = "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbLf
            Str = Str & "<Call xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"">" & vbLf
            Str = Str & "  <Data>" & vbLf & "    <set_aud>" & vbLf & "      <connection>" & vbLf
            Str = Str & "        <messagetype>" & Cells(Rw, "A").Value & "</messagetype>" & vbLf
            Str = Str & "        <order>" & Cells(Rw, "B").Value & "</order>" & vbLf
            Str = Str & "        <storage>" & Cells(Rw, "C").Value & "</storage>" & vbLf
            Str = Str & "        <time_stamp>" & Cells(Rw, "D").Value & "</time_stamp>" & vbLf
            Str = Str & "      </connection>" & vbLf & "    </set_aud>" & vbLf
            Str = Str & "    <interaction>" & Cells(Rw, "E").Value & "</interaction>" & vbLf
            Str = Str & "    <dir>" & Cells(Rw, "F").Value & "</dir>" & vbLf
            Str = Str & "    <hold>" & Cells(Rw, "G").Value & "</hold>" & vbLf
            Str = Str & "    <conference>" & Cells(Rw, "H").Value & "</conference>" & vbLf
            Str = Str & "    <duration>" & Format(Cells(Rw, "I").Value, "hh:mm:ss") & "</duration>" & vbLf
            Str = Str & "    <extension>" & Cells(Rw, "J").Value & "</extension>" & vbLf
            Str = Str & "    <offset>" & Cells(Rw, "K").Value & "</offset>" & vbLf
            Str = Str & "    <login>" & Cells(Rw, "L").Value & "</login>" & vbLf
            Str = Str & "    <agent_name>" & Cells(Rw, "M").Value & "</agent_name>" & vbLf
            Str = Str & "    <group_name>" & Cells(Rw, "N").Value & "</group_name>" & vbLf
            Str = Str & "    <ani>" & Cells(Rw, "O").Value & "</ani>" & vbLf
            Str = Str & "    <dnis>" & Cells(Rw, "P").Value & "</dnis>" & vbLf
            Str = Str & "    <ani1>" & Cells(Rw, "Q").Value & "</ani1>" & vbLf
            Str = Str & "  </Data>" & vbLf & "  <Other>" & vbLf
            Str = Str & "    <c02>" & Cells(Rw, "R").Value & "</c02>" & vbLf
            Str = Str & "    <c03>" & Cells(Rw, "S").Value & "</c03>" & vbLf
            Str = Str & "    <c01>" & Cells(Rw, "T").Value & "</c01>" & vbLf
            Str = Str & "    <c04>" & Cells(Rw, "U").Value & "</c04>" & vbLf
            Str = Str & "    <c05>" & Cells(Rw, "V").Value & "</c05>" & vbLf
            Str = Str & "    <c06>" & Cells(Rw, "W").Value & "</c06>" & vbLf
            Str = Str & "    <c07>" & IIf(Cells(Rw, "X") > 0, Cells(Rw, "X").Value, "") & "</c07>" & vbLf
            Str = Str & "    <c08>" & IIf(Cells(Rw, "Y") > 0, Cells(Rw, "Y").Value, "") & "</c08>" & vbLf
            Str = Str & "    <c09>" & IIf(Cells(Rw, "Z") > 0, Cells(Rw, "Z").Value, "") & "</c09>" & vbLf
            Str = Str & "    <c10>" & IIf(Cells(Rw, "AA") > 0, Cells(Rw, "AA").Value, "") & "</c10>" & vbLf
            Str = Str & "    <c11>" & IIf(Cells(Rw, "AB") > 0, Cells(Rw, "AB").Value, "") & "</c11>" & vbLf
            Str = Str & "    <c12>" & IIf(Cells(Rw, "AC") > 0, Cells(Rw, "AC").Value, "") & "</c12>" & vbLf
            Str = Str & "    <c13>" & IIf(Cells(Rw, "AD") > 0, Cells(Rw, "AD").Value, "") & "</c13>" & vbLf
            Str = Str & "    <c14>" & IIf(Cells(Rw, "AE") > 0, Cells(Rw, "AE").Value, "") & "</c14>" & vbLf
            Str = Str & "    <c15>" & IIf(Cells(Rw, "AF") > 0, Cells(Rw, "AF").Value, "") & "</c15>" & vbLf
            Str = Str & "    <c16>" & IIf(Cells(Rw, "AG") > 0, Cells(Rw, "AG").Value, "") & "</c16>" & vbLf
            Str = Str & "  </Other>" & vbLf & "</Call>" & vbLf
    '        Print #1, Str
    '    Close #1
        With xmlDoc
            .async = False
            .validateOnParse = False
            .resolveExternals = False
        End With
        If Not xmlDoc.LoadXML(Str) Then
            With xmlDoc.parseError
                MsgBox "Error: " & .ErrorCode & vbCrLf & .reason, vbCritical, "Error"
                Exit Sub
            End With
        End If
        xmlDoc.Save outPATH & fNAME
    Next Rw
End Sub

Re: รบกวนสอบถามการแสดงผลจาก VBA แปลงเป็น xml ไฟล์ แต่ไม่ขึ้นภาษาไทย

Posted: Thu Feb 10, 2022 11:15 am
by sutima
ขอบคุณมากๆเลยค่ะ พยายามหาข้อมูลอยู่เกือบเดือน ขอบคุณมากจริงๆค่ะ
All times are UTC+07:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited