Lấy dữ liệu từ file xml bằng VB trong Excel

Dear các bạn.
Hiện tại mình có một ví dụ về file xml như sau:

<?xml version="1.0" encoding="UTF-8"?>
<PersistentObject>
<CUIDESIGN PersistentID="8ae5b13b" ClassName="CUIDESIGN">
<DESIGNNUMBER DataType="8">ABCDE</DESIGNNUMBER>
<AVGCALCTIME DataType="5">654557</AVGCALCTIME>
</CUIDESIGN>
<CUIROOT PersistentID="9c682313" ClassName="CUIROOT">
<DESIGNNUMBER DataType="8">ABCDE</DESIGNNUMBER>
<AVGCALCTIME DataType="5">654557</AVGCALCTIME>
<DBDATE DataType="8">2015/08/14</DBDATE>
<DBTIME DataType="8">04:35:28</DBTIME>
</CUIROOT>

Mình muốn truy cập đến thẻ "CUIDESIGN" và lấy giá trị "DESIGNNUMBER" và đưa vào 1 cell trong file Excel.
Làm thế nào để truy cập đến thẻ "CUIROOT" và lấy giá trị "DBDATE" và đưa vào 1 cell trong file Excel.
Các bạn giúp mình với.
Cảm ơn rất nhiều.

Cụ thể bạn cần lấy những chuỗi nào, cho vào chỗ nào?

Những chuỗi màu đỏ đánh dấu là những chuỗi mình cần lấy giá trị
<?xml version="1.0" encoding="UTF-8"?>
<PersistentObject>
<CUIDESIGN PersistentID="8ae5b13b" ClassName="CUIDESIGN">
<DESIGNNUMBER DataType="8">ABCDE</DESIGNNUMBER>
<AVGCALCTIME DataType="5">654557</AVGCALCTIME>
</CUIDESIGN>
<CUIROOT PersistentID="9c682313" ClassName="CUIROOT">
<DESIGNNUMBER DataType="8">ABCDE</DESIGNNUMBER>
<AVGCALCTIME DataType="5">654557</AVGCALCTIME>
<DBDATE DataType="8">2015/08/14</DBDATE>
<DBTIME DataType="8">04:35:28</DBTIME>
</CUIROOT>

Để đưa vào 2 cell như ảnh đính kèm:

2428

Thanks.

Lấy chính xác toàn bộ chuỗi màu đỏ, đúng không?
Tức cell E14 sau khi chạy code sẽ có giá trị là <DESIGNNUMBER DataType="8">ABCDE</DESIGNNUMBER>
Và cell E16 sau khi chạy code sẽ có giá trị là <DBDATE DataType="8">2015/08/14</DBDATE>

Không , lấy giá trị : ABCDE và : 2015/08/14 ạ. Thanks.

ngày xửa ngày xưa (hình như là 1996) tui có tự xây dựng cấu trúc "bó mía" để lưu trữ dữ liệu. sau này có thằng em nói là rất giống với XML, tui vẫn dùng đến bây giờ.
bạn dùng thử hàm cùi bắp này xem sao (tui đã thử với dữ liệu của bạn, thấy OK)

Public Function SpecifyXML$(s$, StrXML$)
'Returen: string between strhead and strtail
'-------------------------------------------------
    Dim Pos1&, Pos2&, Pos3&, StrHead$, StrTail$
    Pos1 = InStr(1, s, "<" & StrXML, vbTextCompare)
    Pos2 = InStr(Pos1, s, ">", vbTextCompare)
    StrHead = Mid(s, Pos1, Pos2 - Pos1 + 1)
    StrTail = "</" & StrXML & ">"
    If Pos1 > 0 Then
        Pos3 = InStr(Pos1, s, StrTail, vbTextCompare)
        If Pos3 > 0 Then
            SpecifyXML = Mid(s, Pos1 + Len(StrHead), Pos3 - Pos1 - Len(StrHead))
        End If
    End If
End Function

Yêu cầu cái gì phải nói cho rõ ràng. Mãi đến bài thứ 7 người ta mới hiểu cần làm thì thì bạn nên xem lại cách mô tả vấn đề của mình
Giờ chạy thử sub này:

Sub Main()
  Dim fso As Object, oStream As Object
  Dim filePath As String, sTmp As String, sRet As String
  Dim lPos1 As Long, lPos2 As Long
  Dim vFile
  vFile = Application.GetOpenFilename("XML Files, *.xml")
  If TypeName(vFile) = "String" Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    filePath = CStr(vFile)
    Set oStream = fso.OpenTextFile(filePath, 1)
    sTmp = oStream.ReadAll
    oStream.Close
    lPos1 = InStr(1, sTmp, "<DESIGNNUMBER DataType=""8"">")
    If lPos1 Then
      sRet = Mid(sTmp, lPos1 + 27)
      lPos2 = InStr(1, sRet, "<")
      If lPos2 Then
        sRet = Left(sRet, lPos2 - 1)
        Sheets("INPUT").Range("E14").Value = sRet
      End If
    End If
    lPos1 = 0: lPos2 = 0: sRet = Empty
    lPos1 = InStr(1, sTmp, "<DBDATE DataType=""8"">")
    If lPos1 Then
      sRet = Mid(sTmp, lPos1 + 21)
      lPos2 = InStr(1, sRet, "<")
      If lPos2 Then
        sRet = Left(sRet, lPos2 - 1)
        Sheets("INPUT").Range("E16").Value = "'" & sRet
      End If
    End If
  End If
End Sub

Cảm ơn bác ndu96081631,
Sau khi edit lại code, mình up lại code hoàn thiện, file đính kèm: Test2_1.zip .
Nhưng trong code của bác ndu96081631
câu lệnh: sRet = Mid(sTmp, lPos1 + 27) bị phụ thuộc vào độ dài của: lPos1 = InStr(1, sTmp, "<DESIGNNUMBER DataType=""8"">"), phải đến xem có bao nhiêu ký tự. Số 8 (đánh dấu màu đỏ) phải thêm 2 dấu " " . Có cách nào khắc phục được nhược điểm này không bác?
Trong đoạn code VB của bác:

lPos1 = 0: lPos2 = 0: sRet = Empty
lPos1 = InStr(1, sTmp, "<DESIGNNUMBER DataType=""8"">")
If lPos1 Then
sRet = Mid(sTmp, lPos1 + 27)
lPos2 = InStr(1, sRet, "<")
If lPos2 Then
sRet = Left(sRet, lPos2 – 1)
Sheets("INPUT").Range("E14").Value = sRet
End If
End If
Số 27 màu đỏ em đánh dấu là phải đếm số ký tự của chuỗi: "<DESIGNNUMBER DataType=""8"">" phải không ạ? Có cách nào không phải đếm số ký tự của chuỗi này không ạ?

Có cách nào insert các data từ file xml vào file excel như trong hình không bác?
2430

Muốn tìm thì cũng phải có "dấu hiệu" gì đó chứ. Các từ khóa như "<DESIGNNUMBER DataType=""8"">" chẳng phải là "dấu hiệu" sao? Nếu không có nó, ta tìm bằng cái gì?

bắt chước thầy NDU cũng góp vui tí . hi hi

Public Sub hell()
  Dim fso As Object, oStream As Object
  Dim filePath As String, sTmp As String, sRet As String
  Dim vFile
  vFile = Application.GetOpenFilename("XML Files, *.xml")
  If TypeName(vFile) = "String" Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    filePath = CStr(vFile)
    Set oStream = fso.OpenTextFile(filePath, 1)
    sTmp = oStream.ReadAll
    oStream.Close

With Worksheets("INPUT")
        vFile = getInfo(sTmp, "<CUIDESIGN")
        .[H14].Value = vFile(1): .[H16].Value = vFile(2): .[H18].Value = vFile(3)
        vFile = getInfo(sTmp, "<CUIROOT")
        .[K14].Value = vFile(1): .[K16].Value = vFile(2): .[K18].Value = vFile(3)
    End With
  End If
End Sub

Private Function getInfo(sTmp As String, parentNode As String) As Variant
Dim arr(1 To 3), lPos1 As Long, lPos2 As Long, lStart As Long
lPos1 = InStr(sTmp, parentNode)
If lPos1 > 0 Then
    arr(1) = getNodeVL(sTmp, "<DESIGNNUMBER", lPos1)
    arr(2) = getNodeVL(sTmp, "<DBDATE", lPos1)
    arr(3) = getNodeVL(sTmp, "<DBTIME", lPos1)
End If
getInfo = arr
End Function

Private Function getNodeVL(ByVal sTmp As String, ByVal nodeName As String, _
ByVal lPos As Long) As String
Dim lPos2 As Long, lStart As Long
getNodeVL = ""
lPos = InStr(lPos, sTmp, nodeName) + 1
lStart = InStr(lPos, sTmp, ">") + 1
lPos2 = InStr(lPos, sTmp, "<")
If InStr(lPos, sTmp, "/") > lStart Then getNodeVL = Mid(sTmp, lStart, lPos2 - lStart)
End Function

Cảm ơn bác Jack nt, hôm nay em mới thử đoạn code của bác, thấy rất oke và hiệu quả. Thanks bác.

tui cũng hơi lạ không thấy bạn ngó ngàng gì đến. tui sử dụng hàm này thường xuyên từ xưa đến giờ. rất vui giúp được bạn.

Bạn Batman1 có một đoạn code rất hay, mình đưa lên đây các bạn tham khảo:

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 Worksheets("INPUT")             
     .Range("H14").Value = xmldoc.SelectSingleNode("//PersistentObject/CUIDESIGN/DESIGNNUMBER").Text             
       .Range("H16").Value = xmldoc.SelectSingleNode("//PersistentObject/CUIDESIGN/DBDATE").Text             
     .Range("H18").Value = xmldoc.SelectSingleNode("//PersistentObject/CUIDESIGN/DBTIME").Text             
     .Range("K14").Value = xmldoc.SelectSingleNode("//PersistentObject/CUIROOT/DESIGNNUMBER").Text             
     .Range("K16").Value = xmldoc.SelectSingleNode("//PersistentObject/CUIROOT/DBDATE").Text            
     .Range("K18").Value = xmldoc.SelectSingleNode("//PersistentObject/CUIROOT/DBTIME").Text             
End With        
 End If         
Set xmldoc = Nothing     
End If 
End Sub

Cảm ơn bạn batnam1.

www.giaiphapexcel.com/diendan/threads/l%E1%BA%A5y-d%E1%BB%AF-li%E1%BB%87u-t%E1%BB%AB-file-xml-b%E1%BA%B1ng-vb-trong-excel.108034/

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