Trích xuất XML bằng VBA

Các bác ơi
Mình muốn trich xuất dữ liệu của TK GTGT định dạng XML ra excel theo mẫu
Nhưng làm cách nào để khi mở hàng loạt file xml thì khi xuất ra excel nó theo thứ tự 1 dòng cho 1 file xml
Mình không học VBA nên chỉ mò viết được tới đây, các bac help mình với

Sub Main()
Dim filename, xmldoc As Object
filename = Application.GetOpenFilename("XML Files, *.xml")
If TypeName(filename) = "String" Then
Set xmldoc = CreateObject("MSXML2.DOMDocument")
If xmldoc.Load(filename) Then
    With Sheets("Trich xuat")
     .Range("A2").Value = xmldoc.SelectSingleNode("//NNT/mst").Text
     .Range("B2").Value = xmldoc.SelectSingleNode("//NNT/tenNNT").Text
     .Range("C2").Value = xmldoc.SelectSingleNode("//KyKKhaiThue/kyKKhai").Text
     .Range("D2").Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/GiaTriVaThueGTGTHHDVMuaVao/ct23").Text
     .Range("E2").Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/GiaTriVaThueGTGTHHDVMuaVao/ct24").Text
     .Range("F2").Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/TongDThuVaThueGTGTHHDVBRa/ct34").Text
     .Range("G2").Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/TongDThuVaThueGTGTHHDVBRa/ct35").Text
     .Range("H2").Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/ct40").Text
                         End With
 End If
Set xmldoc = Nothing
End If
End Sub

Sửa code lại thế này xem.

Sub Main()
Dim filename, xmldoc As Object, i%, k%
filename = Application.GetOpenFilename("XML Files, *.xml", , , , True)
k = Sheet2.Range("A10000").End(xlUp).Row + 1
    If IsArray(filename) Then
        Set xmldoc = CreateObject("MSXML2.DOMDocument")
        For i = LBound(filename) To UBound(filename)
            If xmldoc.Load(filename(i)) Then
                With Sheets("Trich xuat")
                    .Range("A" & k).Value = xmldoc.SelectSingleNode("//NNT/mst").Text
                    .Range("B" & k).Value = xmldoc.SelectSingleNode("//NNT/tenNNT").Text
                    .Range("C" & k).Value = xmldoc.SelectSingleNode("//KyKKhaiThue/kyKKhai").Text
                    .Range("D" & k).Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/GiaTriVaThueGTGTHHDVMuaVao/ct23").Text
                    .Range("E" & k).Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/GiaTriVaThueGTGTHHDVMuaVao/ct24").Text
                    .Range("F" & k).Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/TongDThuVaThueGTGTHHDVBRa/ct34").Text
                    .Range("G" & k).Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/TongDThuVaThueGTGTHHDVBRa/ct35").Text
                    .Range("H" & k).Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/ct40").Text
                End With
                k = k + 1
             End If
        Next i
        Set xmldoc = Nothing
    ElseIf TypeName(filename) = "String" Then
        Set xmldoc = CreateObject("MSXML2.DOMDocument")
        If xmldoc.Load(filename) Then
            With Sheets("Trich xuat")
                .Range("A" & k).Value = xmldoc.SelectSingleNode("//NNT/mst").Text
                .Range("B" & k).Value = xmldoc.SelectSingleNode("//NNT/tenNNT").Text
                .Range("C" & k).Value = xmldoc.SelectSingleNode("//KyKKhaiThue/kyKKhai").Text
                .Range("D" & k).Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/GiaTriVaThueGTGTHHDVMuaVao/ct23").Text
                .Range("E" & k).Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/GiaTriVaThueGTGTHHDVMuaVao/ct24").Text
                .Range("F" & k).Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/TongDThuVaThueGTGTHHDVBRa/ct34").Text
                .Range("G" & k).Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/TongDThuVaThueGTGTHHDVBRa/ct35").Text
                .Range("H" & k).Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/ct40").Text
            End With
         End If
        Set xmldoc = Nothing
    End If
End Sub

Sao anh không xử lý chỗ chọn file, nếu 1 file thì cho nó vào array(). 🙂

Đúng là không nghĩ tới, đơn giản nhưng hiệu quả.

———————-

Code này khi sửa node chắc nhọc lắm đây.

Chắc phải thêm đoạn sau để xóa bớt:

If Not IsArray(filename) Then filename = Array(filename)

If LCase(filename(i)) Like "*.xml" Then
'''''Load
End If

Bạn ơi, bạn sửa dùm mình, mình không có học VBA nên không biết sửa vô ntn

Sub Main()
Dim filename, xmldoc As Object, i%, k%
filename = Application.GetOpenFilename("XML Files, *.xml", , , , True)
k = Sheet2.Range("A10000").End(xlUp).Row + 1
    If Not IsArray(filename) Then filename = Array(filename)
        Set xmldoc = CreateObject("MSXML2.DOMDocument")
        For i = LBound(filename) To UBound(filename)
            If LCase(filename(i)) Like "*.xml" Then
                If xmldoc.Load(filename(i)) Then
                With Sheets("Trich xuat").Range("A" & k)
                    .Value = xmldoc.SelectSingleNode("//NNT/mst").Text
                    .Offset(0, 1).Value = xmldoc.SelectSingleNode("//NNT/tenNNT").Text
                    .Offset(0, 2).Value = xmldoc.SelectSingleNode("//KyKKhaiThue/kyKKhai").Text
                    .Offset(0, 3).Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/GiaTriVaThueGTGTHHDVMuaVao/ct23").Text
                    .Offset(0, 4).Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/GiaTriVaThueGTGTHHDVMuaVao/ct24").Text
                    .Offset(0, 5).Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/TongDThuVaThueGTGTHHDVBRa/ct34").Text
                    .Offset(0, 6).Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/TongDThuVaThueGTGTHHDVBRa/ct35").Text
                    .Offset(0, 7).Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/ct40").Text
                End With
                k = k + 1
                End If
             End If
        Next i
        Set xmldoc = Nothing
End Sub

Bạn ơi, nếu như trong file xml có 1 vài chỉ tiêu không có, có cách nào viết cho code nếu không có chỉ tiêu đó thì bỏ trống, tiếp tục chạy các dòng sau không.

Đặt đoạn sau vào trên cùng của thủ tục:
On Error Resume Next

Bạn ơi cho mùnh hỏi thêm vụ này nữa nhé
Giống vd nêu trên, nếu file nguồn có nhiều chỉ tiêu "ct40" thì làm sao để lấy ra hết. Mỗi ct40 sẽ ra 1 cột hoặc gom chung lại.
Bạn giúp mình với

Mình cũng quan tâm cái này nên mình viết thử theo code của bài [URL='www.giaiphapexcel.com/diendan/threads/tr%C3%ADch-xu%E1%BA%A5t-xml-b%E1%BA%B1ng-vba.149226/post-966479']#7, bạn kiểm tra kết quả nhé:

Sub zaq()               
Dim filename, xmldoc As Object, I%, k%
On Error Resume Next
filename = Application.GetOpenFilename("XML Files, *.xml", , , , True)
k = Sheet3.Range("A10000").End(xlUp).Row + 1
    If Not IsArray(filename) Then filename = Array(filename)
        Set xmldoc = CreateObject("MSXML2.DOMDocument")
        For I = LBound(filename) To UBound(filename)
            If LCase(filename(I)) Like "*.xml" Then
                If xmldoc.Load(filename(I)) Then
                'With Sheets("Trich xuat").Range("A" & k)
                With Sheet3.Range("A" & k)
                    .Value = xmldoc.SelectSingleNode("//NNT/mst").Text
                    .Offset(0, 1).Value = xmldoc.SelectSingleNode("//NNT/tenNNT").Text
                    .Offset(0, 2).Value = xmldoc.SelectSingleNode("//KyKKhaiThue/kyKKhai").Text
                    .Offset(0, 3).Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/GiaTriVaThueGTGTHHDVMuaVao/ct23").Text
                    .Offset(0, 4).Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/GiaTriVaThueGTGTHHDVMuaVao/ct24").Text
                    .Offset(0, 5).Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/TongDThuVaThueGTGTHHDVBRa/ct34").Text
                    .Offset(0, 6).Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/TongDThuVaThueGTGTHHDVBRa/ct35").Text
                    .Offset(0, 7).Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/ct40").Text
[COLOR=rgb(235, 107, 86)]                    .Offset(0, 8).Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/ct40a").Text
                    .Offset(0, 9).Value = xmldoc.SelectSingleNode("//CTieuTKhaiChinh/ct40b").Text[/COLOR]                 

End With
                k = k + 1
                End If
             End If
        Next I
        Set xmldoc = Nothing
End Sub

2 dòng màu đỏ là mình mới thêm.
Các chỉ tiêu tương tự nếu bạn muốn lấy thì bạn thêm tên các cột tương ứng theo danh sách sau nhé:

/CKyDTu/Signature/KeyInfo/KeyValue/RSAKeyValue/Exponent
 /CKyDTu/Signature/KeyInfo/KeyValue/RSAKeyValue/Modulus
 /CKyDTu/Signature/KeyInfo/X509Data/X509Certificate
 /CKyDTu/Signature/KeyInfo/X509Data/X509SubjectName
 /CKyDTu/Signature/SignatureValue
 /CKyDTu/Signature/SignedInfo/CanonicalizationMethod/@Algorithm
 /CKyDTu/Signature/SignedInfo/Reference/@URI
 /CKyDTu/Signature/SignedInfo/Reference/DigestMethod/@Algorithm
 /CKyDTu/Signature/SignedInfo/Reference/DigestValue
 /CKyDTu/Signature/SignedInfo/Reference/Transforms/Transform/@Algorithm
 /CKyDTu/Signature/SignedInfo/SignatureMethod/@Algorithm
 /HSoKhaiThue/@id
 /HSoKhaiThue/CTieuTKhaiChinh/ct21
 /HSoKhaiThue/CTieuTKhaiChinh/ct22
 /HSoKhaiThue/CTieuTKhaiChinh/ct25
 /HSoKhaiThue/CTieuTKhaiChinh/ct26
 /HSoKhaiThue/CTieuTKhaiChinh/ct29
 /HSoKhaiThue/CTieuTKhaiChinh/ct36
 /HSoKhaiThue/CTieuTKhaiChinh/ct37
 /HSoKhaiThue/CTieuTKhaiChinh/ct38
 /HSoKhaiThue/CTieuTKhaiChinh/ct39
 /HSoKhaiThue/CTieuTKhaiChinh/ct40
 /HSoKhaiThue/CTieuTKhaiChinh/ct40a
 /HSoKhaiThue/CTieuTKhaiChinh/ct40b
 /HSoKhaiThue/CTieuTKhaiChinh/ct41
 /HSoKhaiThue/CTieuTKhaiChinh/ct42
 /HSoKhaiThue/CTieuTKhaiChinh/ct43
 /HSoKhaiThue/CTieuTKhaiChinh/GiaTriVaThueGTGTHHDVMuaVao/ct23
 /HSoKhaiThue/CTieuTKhaiChinh/GiaTriVaThueGTGTHHDVMuaVao/ct24
 /HSoKhaiThue/CTieuTKhaiChinh/HHDVBRaChiuThueGTGT/ct27
 /HSoKhaiThue/CTieuTKhaiChinh/HHDVBRaChiuThueGTGT/ct28
 /HSoKhaiThue/CTieuTKhaiChinh/HHDVBRaChiuTSuat10/ct32
 /HSoKhaiThue/CTieuTKhaiChinh/HHDVBRaChiuTSuat10/ct33
 /HSoKhaiThue/CTieuTKhaiChinh/HHDVBRaChiuTSuat5/ct30
 /HSoKhaiThue/CTieuTKhaiChinh/HHDVBRaChiuTSuat5/ct31
 /HSoKhaiThue/CTieuTKhaiChinh/HHDVBRaKhongTinhThue/ct32a
 /HSoKhaiThue/CTieuTKhaiChinh/tieuMucHachToan
 /HSoKhaiThue/CTieuTKhaiChinh/TongDThuVaThueGTGTHHDVBRa/ct34
 /HSoKhaiThue/CTieuTKhaiChinh/TongDThuVaThueGTGTHHDVBRa/ct35
 /HSoKhaiThue/PLuc
 /HSoKhaiThue/TTinChung/TTinDVu/maDVu
 /HSoKhaiThue/TTinChung/TTinDVu/pbanDVu
 /HSoKhaiThue/TTinChung/TTinDVu/tenDVu
 /HSoKhaiThue/TTinChung/TTinDVu/ttinNhaCCapDVu
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/NNT/dchiNNT
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/NNT/dthoaiNNT
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/NNT/emailNNT
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/NNT/faxNNT
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/NNT/maHuyenNNT
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/NNT/maTinhNNT
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/NNT/mst
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/NNT/phuongXa
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/NNT/tenHuyenNNT
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/NNT/tenNNT
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/NNT/tenTinhNNT
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/TKhaiThue/GiaHan/lyDoGiaHan
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/TKhaiThue/GiaHan/maLyDoGiaHan
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/TKhaiThue/KyKKhaiThue/kieuKy
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/TKhaiThue/KyKKhaiThue/kyKKhai
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/TKhaiThue/KyKKhaiThue/kyKKhaiDenNgay
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/TKhaiThue/KyKKhaiThue/kyKKhaiDenThang
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/TKhaiThue/KyKKhaiThue/kyKKhaiTuNgay
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/TKhaiThue/KyKKhaiThue/kyKKhaiTuThang
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/TKhaiThue/loaiTKhai
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/TKhaiThue/maCQTNoiNop
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/TKhaiThue/maTKhai
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/TKhaiThue/moTaBMau
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/TKhaiThue/nganhNgheKD
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/TKhaiThue/ngayKy
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/TKhaiThue/ngayLapTKhai
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/TKhaiThue/nguoiKy
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/TKhaiThue/pbanTKhaiXML
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/TKhaiThue/soLan
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/TKhaiThue/tenCQTNoiNop
 /HSoKhaiThue/TTinChung/TTinTKhaiThue/TKhaiThue/tenTKhai

www.giaiphapexcel.com/diendan/threads/tr%C3%ADch-xu%E1%BA%A5t-xml-b%E1%BA%B1ng-vba.149226/

Khóa học SprinGO phù hợp

Khóa học Power PI – Ứng dung trong Nhân sự

TỔNG QUAN KHÓA HỌC: POWER BI CHO NGÀNH NHÂN SỰ Khóa học Power BI cho Nhân sự được thiết kế dành riêng cho các...

Xem khóa học