Báo lỗi Dim rsData As ADODB.Recordset!

[ThuNghi]

Tôi đang thực hành ADO, copy file ADO Test thành ADOTest01 thì chạy không sao. Nhưng khi tạo 1 file mới tên ADOTest02, copy những code và UDF vào, khi chạy thì báo lỗi.
Dòng Public màu vàng và báo lỗi dòng
Dim rsData As ADODB.Recordset

Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
          sourceRange As String, TargetRange As Range, Header As Boolean, _
          UseHeaderRow As Boolean)
    Dim rsData As ADODB.Recordset

Nhờ các bạn HD tìm chỗ sai.
Xem file kèm. Cám ơn!
Và xin hỏi thêm, đây là cách lấy dl từ file đang đóng, nếu lỡ nó đang mở thì co cần phải đóng nó lại.

 

[sealand]

Bạn vào tools-->Refe..--> đánh dấu vào Microsoft ActiveX Oject 2.1 Liabrary
Không cần đóng lại bạn ạ, chỉ cầqn đường dẫn khả dụng là được.

 

[ThuNghi]

Bạn vào tools-->Refe..--> đánh dấu vào Microsoft ActiveX Oject 2.1 Liabrary

Cám ơn anh!
Microsoft ActiveX Data Object 2.1 Liabrary
Có phải cái này, thêm Data.
Cái này mỗi file phải set hả. Em thấy có tới 2.8, vậy chọn cái cao I.

 

[sealand]

Chỉ cần 1 trong số đó. Tất nhiên cái cao hơn sẽ hỗ trợ tốt hơn, nhưng nếu chưa nghiên cứu kỹ thì dễ bị lối cú pháp.

 

[ThuNghi]

Cho em hỏi, trong các ví dụ trên, ta chỉ copy A1:C5, nhưng bây giờ ta muốn C5 là biến Cells(ERow,ECol) thì làm thế nào. Không lẽ ta cứ copy A1:C50000 rồi xử lý tại sh Đích.
Ý em là xác nhận vàng cần lấy.

 

[vbavn]

To: Anh ThuNghi,
Nếu anh dùng late binding (tức là khai báo trể) thì sẽ không cần phải làm động tác tham chiếu

Anh chỉ việc thay:

Dim rsData As ADODB.Recordset

bằng

Dim rsData As Object

set rsData=CreateObject("ADODB.Recordset")

Có thể tham khảo tại http://www.giaiphapexcel.com/forum/showthread.php?t=15612

Vbavn

 

[sealand]

GetData ThisWorkbook.Path & "\test.xls", "Sheet1", _
           [B][COLOR=Red] "A1:C5"[/COLOR][/B], Sheets("Sheet1").Range("A1"), True, True

Bạn thấy thực chất câu lệnh trên chỉ là 1 chuỗi ghi địa chỉ vùng. Bạn chỉ cần gán cho chuỗi tuơng ứng là được. Còn trong câu lệnh mình thay thế bằng biến chuỗi. Xin lỗi mình chưa test không biết câu lệnh có chấp nhận tham chiếu dạng RC không.

Ví dụ câu lệnh trên ta có thể dùng

Dim vung as string
vung= "A1:" & Chr(64 + ECol) & ERow
GetData ThisWorkbook.Path & "\test.xls", "Sheet1", _
           [B][COLOR=Red] vung[/COLOR][/B], Sheets("Sheet1").Range("A1"), True, True

Như vậy bạn có thể gán địa chỉ theo 2 biến ERow, ECol

 

[ThuNghi]

To: Anh ThuNghi,
Anh chỉ việc thay:

Dim rsData As ADODB.Recordset

bằng

Dim rsData As Object
set rsData=CreateObject("ADODB.Recordset")

Có thể tham khảo tại http://www.giaiphapexcel.com/forum/showthread.php?t=15612

Đang nhập môn nên từ từ, mình chỉ học qua ví dụ. Rất cám ơn, đã thấy link nhưng chưa down về. Để có chút vốn liếng đã.
To SeaLand: Vùng này là

Dim vung as string
vung= "A1:" & Chr(64 + ECol) & ERow
GetData ThisWorkbook.Path & "\test.xls", "Sheet1", _
            vung, Sheets("Sheet1").Range("A1"), True, True

Không mở file, Sheet cần copy lấy đâu mà biết ERow, cái này là độ dài của Range cần copy. ECol thì có thể cổ định.
Chẳng lẽ copy nếu Ai <>"".
Bác cho em 1 ví dụ copy từ Test vào ADOTest hộ em. Vùng copy Test là A1:Ci
i=[C65000].end(xlup).row (WB Test Sheet1)

 

[sealand]

Thu Nghi ơi thế rsData là gì. Bạn chỉ cần rsData.recordcount thì biết vùng dữ liệu có bao nhiêu dòng thôi. Còn ECol là rsData.Fieldcount

 

[sealand]

GetData ThisWorkbook.Path & "\test.xls", "Sheet1", _
           [B][COLOR=Red] "A:C"[/COLOR][/B], Sheets("Sheet1").Range("A1"), True, True

Bạn viết như trên cũng được bạn ạ. SQL đâu có nhặt dòng trống.
Xin lỗi, bài trước chưa đọc kỹ func của bạn. Code của bạn đòi hỏi xác định ERow trước khi tạo rsData, muốn vậy phải viết 1 hàm riêng sử dụng SQL với hàm nội tại

 

[ThuNghi]

Hóa ra là vậy, em chỉ nghĩ là Function GetData là chỉ lấy dữ liệu theo vùng chỉ định.
Cám ơn anh nhiều, anh cũng nghiên cứu vấn đề này tường tận nhỉ.

 

[sealand]

To Thu Nghi: bạn có thể tham khảo sub sau để đếm số dòng của sh1 file TEST đang đóng. Bạn chuyển sang hàm nhé:

Public Sub dem()
Dim SourceFile, cnstr As String
Dim dem
Dim rec As New ADODB.Recordset
Dim cn As New ADODB.Connection

Set cn = New ADODB.Connection
SourceFile = ThisWorkbook.Path & "\test.xls"
cnstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & SourceFile & ";Extended Properties=""Excel 8.0;HDR=Yes"";"
cn.Open cnstr
Set rec = cn.Execute("select count(Name) from [Sheet1$]")
dem = rec.Fields(0)
MsgBox dem
cn.Close
rec.Close
Set rec = Nothing
Set cn = Nothing
End Sub

 

[ThuNghi]

Nếu đã SQL thì chỉ lấy dữ liệu thì cần thiết phải làm UDF không, để em làm thử nhé.
Anh test hộ code "rừng" của em làm về ADO có sai gì quan trọng không. Em vận dụng các code ADOTest trên GPE làm. Mấy cái này thấy lâu rồi may nhờ có anh HD.
Từ file TongHop Sh NKC lấy dữ liệu từ các file TN01...
Anh reply liền nhé.
Cám ơn!

 

[sealand]

To Thu Nghi:Quá hay đấy chứ không biết bạn có để ý không nếu bạn chon tất cả thì thì nó cũng chay luôn chứ không cần thiết chạy từng file, không lỗi và tốc độ nhanh. Bravo.

.InitialFileName = MyPath (Có vấn đề vì Dialog không mở ra thư mục chứa File TONGHOP)
Mình không có khái niệm code "rừng" vì mình coi trong các doạn code được Việt hóa cao, có thể mình ảnh hưởng văn phong tin học của Ông Văn Thông chăng?

Mình đưa cái Code ở bài 12# lên để bạn thấy ngoài việc chép rút dũ liệu còn có thể tính toán. Bạn nghĩ sao khi thay hàm count băng hàm Sum hay 1 số hàm khác và SQL có Where (Mình thích cái này vì ít hạn chế hơn về DK). Mà khi đã kết hợp hàm với SQL thì tốc độ tính toán sẽ nhanh gấp nhiều lần. Mình thấy bạn đang làm 1 số file TH dữ liệu từ 1 số file đóng khác. Vậy thì tại sao lại không dùng UDF hay Sub dạng này.

 

[ThuNghi]

.InitialFileName = MyPath (Có vấn đề vì Dialog không mở ra thư mục chứa File TONGHOP)

Cái này copy mà chưa đến nới, đến chốn. Để em test lại
Anh kiểm tra hộ code sau có đúng không, do không thoát Excel nên Excel cứ mặc định folder. Xử lý for i thấy hơi vụng.

Sub LayDuLieuADO()
Dim SaveDriveDir As String, MyPath As String, i As Long, N As Long
Dim FName '(1 To 100) ' As Variant
Dim DestRange As Range
Dim sh As Worksheet
shName = "NKC"
MyPath = ThisWorkbook.Path
With Application.FileDialog(msoFileDialogOpen)
  .InitialFileName = MyPath
  .Filters.Clear
  .AllowMultiSelect = True
  .Filters.Add "Excel files", "*.xls"
  .Show
  If .SelectedItems.Count = 0 Then
    MsgBox "Ban chua chon file"
    Exit Sub
  End If
  Sheets("NKC").Range("A9:N1000").ClearContents
  ReDim FName(1 To .SelectedItems.Count)
  For i = 1 To .SelectedItems.Count
    FName(i) = .SelectedItems(i)
  Next
If IsArray(FName) Then
        ' Sort the Array
        FName = Array_Sort(FName)
        Application.ScreenUpdating = False
        'Loop through all files you select in the GetOpenFilename dialog
        For N = LBound(FName) To UBound(FName)
            'Find the last row with data
            endR = Sheets("NKC").[a65000].End(xlUp).Row
            'create the destination cell address
            Set DestRange = Sheets("NKC").Cells(endR + 1, "A")
            'Get the cell values and copy it in the destrange
            'Change the Sheet name and range as you like
            GetData FName(N), shName, "A10:M1000", DestRange, False, False
            ' For testing Copy the workbook name in Column N
            eRow = Sheets("NKC").[a65000].End(xlUp).Row
            Sheets("NKC").Range("N" & endR + 1 & ":N" & eRow).Value = Right(FName(N), 8)
        Next
    End If
    ChDrive SaveDriveDir
    'ChDir SaveDriveDir
    Application.ScreenUpdating = True
End With
End Sub

 

[sealand]

Chúc mừng Thu Nghi:
Chạy thử thấy File chạy tốt, tốc độ đạt yêu cầu khi mình đã chép điền thêm số liệu tương đối. Mình thử ở 3 máy thấy ổn định.
Chắc mới tạm thời nên còn cố định vùng xoá dữ liệu, vùng chép. Nếu xác định vùng động thì yên tâm hơn.
Theo mình Code của Thu Nghi tốt quá rồi , mong sớm thấy "Thành Phẩm".

 

[ThuNghi]

Còn vấn đề này em muốn hỏi, ví dụ ta muốn lấy dừ liệu từ > 2 Sh thì nên làm theo vòng lặp thế nào.
1/ Lấy 1 Sh hết các file và lấy tiếp Sh
2/ Lấy toàn bộ sh của 1 file, next
Em chưa thử, theo anh nên làm theo cách nào. Em đang muốn làm giúp 1 người bạn lấy dữ liệu xuất và nhập của nhiều file -> tính NXT.

 

[sealand]

Đương nhiên là phải lấy hết Sh của 1 File rồi Next vì như vậy hết 1 Sh ta chỉ đổi CommandText thôi còn Connect là không đổi cho đến khi chuyển sang File mới, còn PA1 thì Connect thay đổi mối Sh mà Connect thay đổi thì RecordSet dựa trên nó đâu còn do vậy rất dễ phát sinh lỗi và chậm.

P/án 1: Reset Rec và Conn qua mỗi Sh
P/an2: Chỉ Reset Rec qua 1 Sh-Chỉ Reset Conn qua 1 File

Vậy nên chọn P/án 2 thôi.

 

[ThuNghi]

....
 Set rsData = New ADODB.Recordset
    rsData.Open szSQL, szConnect, adOpenForwardOnly, _
                adLockReadOnly, adCmdText
    ' Check to make sure we received data and copy the data
    If Not rsData.EOF Then
        TargetRange.Cells(DongDau, 1).CopyFromRecordset rsData
...

Nhờ các bạn diễn nôm các dòng trích sau từ code. Nhìn thấy có vẻ đơn giản mà chưa hiểu lắm.
Cám ơn!

 

[sealand]

Set rsData = New ADODB.Recordset
Gán biến rsData là tập hợp bản ghi mới của ADODB

rsData.Open szSQL, szConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText
Open szSQL:Mở tập hợp bản ghi theo câu lệnh SQL
szConnect: dữ liệu được kết nối xác định theo biến szConnect
adOpenForwardOnly:Mở theo dạng chỉ dịch chuyển lên (Nhanh hơn nhưng hạn chế sử lý),mở chỉ đọc không cho thêm, xóa , sửa
adCmdText:Xác định kiểu dữ liệu kết nối (Có thể là bảng, câu lệnh SQL, Proceduce...)

If Not rsData.EOF Then
Nếu không phải là dòng cuối cùng (Tức là có dữ liệu vì khi mở theo dạng adOpenForwardOnly thì con trỏ luôn ở bản ghi đầu tiên, không phải dùng lệnh rsData.Movefirst

TargetRange.Cells(DongDau, 1).CopyFromRecordset rsData
Chép dữ liệu từ tập hợp bản ghi vào trang (Chỉ áp dụng từ Office 2000 trở lên, Office 97 dùng GetRow)
theo địa chỉ ô đầu là TargetRange.Cells(DongDau, 1)
...