Hỏi về VBA cách lấy dự liệu từ file *.txt

[duongrcfee]

Xin chào mọi người!
Mình có một vấn đề mong được cả nhà chỉ giáo!
Mình muốn dùng VBA để lấy dữ liêu từ file *.txt, mình đã tham khảo bài viết của một bạn trong diễn dần với code như sau:

Option Explicit
Sub Main()
Dim sFolder, txtFile As String, sWksName As String
Dim aFiles, Arr, wkbNew As Workbook
Dim lCount As Long, i As Long, n As Long, lWksCount As Long
On Error Resume Next
With CreateObject("Shell.Application")
sFolder = .BrowseForFolder(0, "", 1).Self.Path
End With
If TypeName(sFolder) = "String" Then
If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
aFiles = GetListFile(sFolder, "*.txt", False)
If IsArray(aFiles) Then
lCount = UBound(aFiles) + 1
ReDim Arr(1 To lCount)
Set wkbNew = Workbooks.Add
With wkbNew
lWksCount = lCount - .Sheets.Count
If lWksCount > 0 Then
.Worksheets.Add After:=.Sheets(.Sheets.Count), Count:=lWksCount
End If
End With
With CreateObject("Scripting.FileSystemObject")
For i = 0 To UBound(aFiles)
txtFile = sFolder & aFiles(i)
sWksName = Left(aFiles(i), InStrRev(aFiles(i), ".") - 1)
n = n + 1
Arr = GetValFromTxt(txtFile)
With wkbNew.Sheets(n)
.Range("A1").Resize(UBound(Arr)).Value = Arr
.Name = Left(sWksName, 31)
End With
Next
End With
End If
End If
End Sub
Function GetValFromTxt(ByVal txtFile As String)
Dim tmpArr, Arr()
Dim n As Long, i As Long
On Error Resume Next
With CreateObject("Scripting.FileSystemObject")
If .FileExists(txtFile) Then
With .OpenTextFile(txtFile, 1, , -2)
tmpArr = Split(.ReadAll, vbCrLf)
If IsArray(tmpArr) Then
ReDim Arr(1 To UBound(tmpArr) + 1, 1 To 1)
For i = 0 To UBound(tmpArr)
n = n + 1
Arr(n, 1) = CStr(tmpArr(i))
Next
If n Then GetValFromTxt = Arr
End If
.Close
End With
End If
End With
End Function
Function GetListFile(ByVal Folder As String, ByVal Search As String, ByVal InSub As Boolean)
Dim sComm As String, tmp As String, tmpFile, Arr
On Error Resume Next
If Right(Folder, 1) <> "\" Then Folder = Folder & "\"
Folder = """" & Folder & """"
With CreateObject("Scripting.FileSystemObject")
tmpFile = .GetTempName
sComm = "DIR " & Folder & Search & " /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

Nhưng mình muốn chỉnh sửa một chút mong mọi nguời giúp đỡ:
- Mình muốn lấy dữ liệu từ file *.txt vào sheet2 (hoặc sửa tên là data) chứ không mở 1 flie mới
- Các file *.txt khi đưa vào sẽ nằm trong 1 sheet
- Dữ liệu đưa vào thành dạng bảng
- Và thêm code để tự động save
Rất mong nhận được sự giúp đỡ của mọi người
Chân thành cảm ơn!
PS: Mình gửi cả file đính kèm nhé)

 

[befaint]

Dạ ý em là lấy luôn dòng đầu tiên trong dữ liệu file text đó anh. Code này dòng đầu tiên của bảng dữ liệu đc xem là tiêu đề nên chỉ lấy từ dòng thứ 2 trở đi.

Nhưng đây là chủ đề của người ta, file dữ liệu của người ta mà.
Không lẽ giống nhau y chang?

 

[khanhhero]

Nhưng đây là chủ đề của người ta, file dữ liệu của người ta mà.
Không lẽ giống nhau y chang?

Dạ em chạy code này với file của em kết quả ko thay đổi anh. Em chỉ thắc mắc chỗ làm cách nào để lấy luôn dòng đầu tiền trong file text thôi. Chứ e chạy code ok rồi anh.

 

[khanhhero]

Em tìm được rồi, sửa
For row = 1 To UBound(NumOfLines) thành
For row = 0 To UBound(NumOfLines)

 

[befaint]

Em tìm được rồi, sửa
For row = 1 To UBound(NumOfLines) thành
For row = 0 To UBound(NumOfLines)

Như thế sẽ có dòng tiêu đề lặp lại nhiều lần (ứng với mỗi file text) ở bảng tổng hợp.

 

[khanhhero]

Như thế sẽ có dòng tiêu đề lặp lại nhiều lần (ứng với mỗi file text) ở bảng tổng hợp.

Dạ tại em muốn hiểu cách lấy dữ liệu đó anh, với em chỉ import một file duy nhất thôi ah.