lỗi không copy được dữ liệu từ file text vào excel (sử dụng ADO)

[hoabattu3387]

Mình có viết đoạn code copy dữ liệu từ file text vào excel (sử dụng ado). Tuy nhiên báo lỗi "unspecified error". Nhờ các anh chị diễn đàn kiểm tra giúp mình xem đoạn code sau bị lỗi ở đâu và sửa giúp mình với. Mình cảm ơn cả nhà!

Private Sub CommandButton2_Click()
Dim I As Integer
Dim cn As New ADODB.Connection
Dim RCS As New ADODB.Recordset
Dim flog As FileDialog
Set flog = Application.FileDialog(msoFileDialogFilePicker)
With flog
.AllowMultiSelect = True
.Show
.Filters.Clear
.Filters.Add "textfiles", "*.txt"
End With
For I = 1 To flog.SelectedItems.Count
filename = flog.SelectedItems(I)
cn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Left(filename, Len(filename) - Len(Split(filename, "\")(5)) - 1) & ";Extended Properties=""text;HDR=no;FMT=fixed;"";")
With ThisWorkbook.Sheets("ALLDOCS")
a = .[a1048576].End(xlUp).Row
End With
With Sheet1
Sql = "select * from " & Split(filename, "\")(5)
.Range("A" & a + 1).CopyFromRecordset cn.Execute(Sql)
End With
Set cn = Nothing
Next
MsgBox ("Completely")
End Sub

 

[ongke0711]

- Bạn phải xem lại các cú pháp dùng ADO nhé. HDR:Yes --> là dòng đầu tiên là dòng tiêu đề.
- Tập thói quen khai báo biến tường minh. Option Explicit.

Code đã sửa:

Option Explicit

Sub Button2_Click()
    Dim I As Integer, a As Integer
    Dim cn As New ADODB.Connection
    Dim RCS As New ADODB.Recordset
    Dim flog As FileDialog
    Dim FileFullPath As String, FilePath As String
    Dim Filename As String
    Dim Sql As String
   
   
    Set flog = Application.FileDialog(msoFileDialogFilePicker)
    With flog
        .AllowMultiSelect = True
        .Show
        .Filters.Clear
        .Filters.Add "textfiles", "*.txt"
    End With
    For I = 1 To flog.SelectedItems.Count
        FileFullPath = flog.SelectedItems(I)
        FilePath = Left(FileFullPath, InStrRev(FileFullPath, "\"))
        cn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FilePath & ";Extended Properties=""text;HDR=Yes;FMT=Delimited;"";")
        Filename = Right(FileFullPath, Len(FileFullPath) - InStrRev(FileFullPath, "\"))
       
        Sql = "select * from " & Filename
       
        With ThisWorkbook.Sheets("ALLDOCS")
            a = .[a1048576].End(xlUp).Row
        End With
        With Sheet1
            .Range("A" & a + 1).CopyFromRecordset cn.Execute(Sql)
        End With
        Set cn = Nothing
    Next
    MsgBox ("Completely")
End Sub

 

[hoabattu3387]

Em đã test, khi chạy đã không báo lỗi, tuy nhiên vẫn chưa import được anh ạ.

 

[ongke0711]

À tôi không để ý kỹ file .txt của bạn. File txt này của bạn đúng là gây điên não cho máy tính luôn đó.
File không có một dấu hiệu gì để máy nó phân biệt cột này với cột khác.
Nếu tên cột có khoảng trắng thì giữa các cột phải phân biệt bằng dấu phẩy ",", dấu "|"... gì đó khác với dấu cách.
Nếu tên cột bạn viết liền nhau thì có thể phân biệt cột này với cột khác bằng dấu cách nhưng khi đó xét tới các dòng dữ liệu. Nếu dữ liệu (như họ tên,...) có khoảng trắng giữ các từ thì máy cũng phân biệt nhầm.
Do đó tốt nhất là khi xuất file text, giữa các cột dữ liệu phải cách nhau bằng một ký hiệu gì đó khác dấu cách.
Cách thứ 2 là xuất file ra dạng XML.

 

[hoabattu3387]

Không còn cách nào hả anh?

 

[ongke0711]

Có nhiều cách để đọc file text bạn à.
Do bạn đang dùng ADO để đọc file text nên tôi cũng nói sơ về trường hợp này.
Cái tay ADO này cũng khá khó tính, nó muốn cái gì cũng phải theo chuẩn mực thì mới tiến hành xử lý cho. ADO nó thiên về chuẩn hoá database nên cái file text cũng phải chuẩn hoá. Nếu file text dạng XML (well-formed database) thì nó xử lý nhanh luôn nhưng đây là file text dạng "Tab Delimited" nên õng ẹo không xử lý hoặc xử lý không đúng.

Cách xử lý khác là dùng Line Input # để đọc file Text vào biến rồi ghi xuống Excel. Cách này chỉ dùng cho các file có số dòng ít ít vì cách nó làm là đọc từng dòng và ghi vào từng dòng Excel. Nếu file Text lớn (ví dụ: 1.048.000 dòng) thì dùng cách ghi vào mảng, sau đó ghi toàn bộ cái mảng lớn đó xuống một cái range của Excel một lần luôn, hiệu suất hơn nhiều.
Vụ mảng thì không rành nhờ các bạn khác hỗ trợ giùm, tôi chỉ demo cho bạn cách đơn giản là ghi từng dòng thôi nhé.

Function DocGhiTextFile() As Boolean
    On Error GoTo EH

    Dim iRow As Integer, iCol As Integer
    Dim sRecord As String, sItem As String
    Dim sFileName As String     'Lay full duong dan toi file Text
    Dim fso As Object
    Dim i As Integer

    DocGhiTextFile = False

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fso = Application.FileDialog(3)     'msoFileDialogFilePicker = 3
    With fso
        .AllowMultiSelect = False    'True
        .Show
        .Filters.Clear
        .Filters.Add "Textfiles", "*.txt"
        sFileName = .SelectedItems(1)
    End With
    If sFileName = "" Then Exit Function

    Open sFileName For Input As 1
    iRow = 5    'Dia chi dòng/Cot sheet Excel càn ghi du lieu xuong
    iCol = 1
    While EOF(1) = False
        Line Input #1, sRecord
        iCol = 1
        While sRecord <> ""
            If InStr(sRecord, Chr(9)) > 0 Then      'Chr(9): vbTab - File text phân biet các côt = dau cách
                sItem = Left(sRecord, InStr(sRecord, Chr(9)) - 1)
                sRecord = Mid(sRecord, InStr(sRecord, Chr(9)) + 1)
            Else
                sItem = sRecord
                sRecord = ""
            End If
            Cells(iRow, iCol) = sItem
            iCol = iCol + 1
            DoEvents
        Wend
        iRow = iRow + 1
        DoEvents
    Wend

    Close 1

    DocGhiTextFile = True

EH_Exit:
    Exit Function

EH:
    DocGhiTextFile = False
    MsgBox "Mã Loi: " & Err.Number & vbNewLine & "Nôi dung loi: " & Err.Description, vbCritical, "Thông báo"
    Resume EH_Exit

End Function

- Gọi hàm cho nút lệnh:

Sub Button2_Click()
    If DocGhiTextFile Then
        MsgBox ("Completely")
    Else
        MsgBox "Failed to import"
    End If

End Sub

 

[hoabattu3387]

Em cảm ơn anh nhé! Anh hyperlink cách dùng line input để e tham khảo với ạ!