Lỗi khi muốn nhập dữ liệu .txt vào excel bằng lệnh macro (1 người xem)

[vubaduc1993]

em muốn tạo lệnh macro trong excel tự động lấy dữ liệu file .txt ở thư mục vào excel
giả sử em muốn auto nhập ô A1 - lấy dữ liệu file data.txt ở thư mục ổ E - file data chỉ có 3 dòng thôi - nhưng em muốn tạo nút tắt để tự động nhập vào A1 ở các sheet thôi
không hiểu tạo sao khi em stop và nhập lại thì hiện run-time error '5' :
Sub rad()
'
' rad Macro
'
' Keyboard Shortcut: Ctrl+r
'
With ActiveSheet.QueryTables.Add(Connection:="TEXT;E:\data.txt", Destination _
:=Range("$A$1"))
.CommandType = 0
.Name = "data"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1258
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

bác nào có cách sửa được không hay làm cách khác được không thì chỉ em tí

 

[LEHOC]

Đính kèm 1 file excel kết quả & file txt ban đầu lên đây ắc có nhiều giải pháp cho bạn.

Em có 1 vấn đề tương tự, mong các anh/chị giúp đỡ em ạ.
Em cảm ơn.
Em bị lỗi Run-time erro '5': Invalid Procedure Call or Argument tại dòng 51

.CommandType = 0

Của Sub sau:

Sub ImportTextFiles()
Dim index As Long, r As Long, c As Long, n As Long, linecount As Long, text As String
Dim Rng As Range, fso As Object, ts As Object, Arr(), files, lines, items
    files = Application.GetOpenFilename("Text Files (*.txt), *.txt", , , , True)
    If IsArray(files) Then
        Sheet1.Range("A1:A65536").EntireRow.Delete
        Set Rng = Sheet1.Range("A1")
        Set fso = CreateObject("Scripting.FileSystemObject")
        For index = LBound(files) To UBound(files)
'            n = 0
            n = 1
            Set ts = fso.OpenTextFile(files(index), 1, , -2)
            lines = Split(ts.ReadAll, vbCrLf)
            linecount = UBound(lines)
            With ActiveSheet.QueryTables.Add(Connection:="TEXT;ts", Destination:=Range("$A$" & n))
                .CommandType = 0
'                .Name = "3D  19993"
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .TextFilePromptOnRefresh = False
                .TextFilePlatform = 65001
                .TextFileStartRow = 1
                .TextFileParseType = xlFixedWidth
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = True
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = False
                .TextFileSpaceDelimiter = False
                .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
                .TextFileFixedColumnWidths = Array(12, 46, 7, 5, 36, 17, 10, 12, 15, 37)
                .TextFileTrailingMinusNumbers = True
                .Refresh BackgroundQuery:=False
            End With
            n = n + linecount
        Next index
        Set ts = Nothing
        Set fso = Nothing
   
        ThisWorkbook.Save
    End If
End Sub

Trong code trên em muốn dòng sau sẽ lấy tên theo file mà vòng For đang chạy thì phải làm sao ạ.

.Name = "3D 19993"

Link file để Import ạ:
file 1
file 2

 

[pham ha 94]

Mình đang gặp đúng luôn lỗi này mà chưa biết sửa sao