Help!! Có cách nào đưa dữ liệu từ nhiều file xml vào trong excel

Liên hệ QC

gghh

Thành viên mới
Tham gia
2/11/11
Bài viết
49
Được thích
2
Vấn đề là em có độ 10.000 file xml, tên file được đặt tên theo kiểu random do 1 chương trình nào đó tạo ra. Giờ có cách nào đưa dữ liệu 10.000 file xml đó vào cùng 1 sheet trong excel không. mà không làm thủ công add từng file 1. - - -
aa.jpg
 
Lần chỉnh sửa cuối:
Vấn đề là em có độ 10.000 file xml, tên file được đặt tên theo kiểu random do 1 chương trình nào đó tạo ra. Giờ có cách nào đưa dữ liệu 10.000 file xml đó vào cùng 1 sheet trong excel không. mà không làm thủ công add từng file 1. +-+-+-+

Chưa thử việc này lần nào nên không chắc
Bạn đưa lên đây chừng 3 file xml, tôi thí nghiệm xong sẽ hướng dẫn bạn cách làm
 
3 file em up lên rồi đó. Xin cám ơn
 

File đính kèm

  • Ấp Mỹ Sơn Đông.rar
    3.6 KB · Đọc: 83
Lần chỉnh sửa cuối:
3 file em up lên rồi đó. Xin cám ơn

Dựa vào 3 file của bạn, tôi tiến hành thí nghiệm bằng cách record macro quá trình import bằng tay rồi chỉnh lại code
Mã:
Function GetListFile(ByVal Folder As String, ByVal Search As String, ByVal InSub As Boolean)
  Dim sComm As String, tmp As String, tmpFile, Arr, sPath As String
  On Error Resume Next
  If Right(Folder, 1) <> "\" Then Folder = Folder & "\"
  sPath = """" & Folder & "*" & Search & "*"""
  With CreateObject("Scripting.FileSystemObject")
    tmpFile = .GetTempName
    sComm = "DIR " & sPath & " /ON /B /A-D " & IIf(InSub, "/S", " ") & " >" & tmpFile
    CreateObject("Wscript.Shell").Run "cmd /u /c " & sComm, 0, True
    With .OpenTextFile(tmpFile, 1, , -2)
      tmp = Trim(.ReadAll)
      If Right(tmp, 2) = vbCrLf Then tmp = Left(tmp, Len(tmp) - 2)
      If Len(tmp) Then GetListFile = Split(tmp, vbCrLf)
      .Close
    End With
  End With
  Kill tmpFile
End Function
Mã:
Sub Main()
  Dim sFile As String, sFolder As String
  Dim aFiles, fleItem, Target As Range
  sFolder = CreateObject("Shell.Application").BrowseForFolder(0, "", 1).Self.Path
  aFiles = GetListFile(sFolder, "*.xml", True)
  Sheet2.UsedRange.Clear
  With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    For Each fleItem In aFiles
      Set Target = Sheet2.Range("A60000").End(xlUp).Offset(1)
      sFile = CStr(fleItem)
      ThisWorkbook.XmlImport sFile, Nothing, True, Target
    Next
    .DisplayAlerts = True
    .ScreenUpdating = True
  End With
End Sub
Việc của bạn là:
- Mở file tôi đính kèm dưới đây
- Bấm nút 'Run code'
- Cửa sổ Browse Folder hiện ra, bạn duyệt tới thư mục chứa file xml rồi bấm OK
- Code chạy xong, bạn sang sheet2 để xem kết quả
-------------------------
Tôi không chắc lắm về tốc độ của code nên bước đầu bạn nên để trong thư mục chừng 100 file thôi... Khi cảm thấy code chạy ổn định rồi hẳn import nhiều file
 

File đính kèm

  • ImportXML.rar
    25.5 KB · Đọc: 311
Anh có thể viết giúp em trên access như file import của anh đc không. Cảm ơn nhiều.
 
Dựa vào 3 file của bạn, tôi tiến hành thí nghiệm bằng cách record macro quá trình import bằng tay rồi chỉnh lại code
Mã:
Function GetListFile(ByVal Folder As String, ByVal Search As String, ByVal InSub As Boolean)
  Dim sComm As String, tmp As String, tmpFile, Arr, sPath As String
  On Error Resume Next
  If Right(Folder, 1) <> "\" Then Folder = Folder & "\"
  sPath = """" & Folder & "*" & Search & "*"""
  With CreateObject("Scripting.FileSystemObject")
    tmpFile = .GetTempName
    sComm = "DIR " & sPath & " /ON /B /A-D " & IIf(InSub, "/S", " ") & " >" & tmpFile
    CreateObject("Wscript.Shell").Run "cmd /u /c " & sComm, 0, True
    With .OpenTextFile(tmpFile, 1, , -2)
      tmp = Trim(.ReadAll)
      If Right(tmp, 2) = vbCrLf Then tmp = Left(tmp, Len(tmp) - 2)
      If Len(tmp) Then GetListFile = Split(tmp, vbCrLf)
      .Close
    End With
  End With
  Kill tmpFile
End Function
Mã:
Sub Main()
  Dim sFile As String, sFolder As String
  Dim aFiles, fleItem, Target As Range
  sFolder = CreateObject("Shell.Application").BrowseForFolder(0, "", 1).Self.Path
  aFiles = GetListFile(sFolder, "*.xml", True)
  Sheet2.UsedRange.Clear
  With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    For Each fleItem In aFiles
      Set Target = Sheet2.Range("A60000").End(xlUp).Offset(1)
      sFile = CStr(fleItem)
      ThisWorkbook.XmlImport sFile, Nothing, True, Target
    Next
    .DisplayAlerts = True
    .ScreenUpdating = True
  End With
End Sub
Việc của bạn là:
- Mở file tôi đính kèm dưới đây
- Bấm nút 'Run code'
- Cửa sổ Browse Folder hiện ra, bạn duyệt tới thư mục chứa file xml rồi bấm OK
- Code chạy xong, bạn sang sheet2 để xem kết quả
-------------------------
Tôi không chắc lắm về tốc độ của code nên bước đầu bạn nên để trong thư mục chừng 100 file thôi... Khi cảm thấy code chạy ổn định rồi hẳn import nhiều file




em chào anh.
em dùng file chạy của anh nhưng báo lỗi 1004 ạ
Nhờ anh xem hộ em sao chạy file ghép của Anh lại không được ạ.
em gửi kèm 3 file mẫu trong 500 file ạ
em cảm ơn anh.
 

File đính kèm

  • HDD.rar
    6.6 KB · Đọc: 11
Web KT
Back
Top Bottom