Kết nối với file Excel đang đóng, dùng ADODB

[leduy78]

Chào các bác, em có 2 file excel: OrderList.xlsm, ListofCTKM.xlsm
Em muốn từ file OrderList truy cập vào file ListofCTKM thông qua giao thức ADODB.
Em đã viết các Sub rồi, nhưng không rõ lý do gì mà không chạy được.

Sub đầu tiên

"
Public FName As String
Public cnnEx As New ADODB.CONNECTION
Public RSTEx As New ADODB.Recordset
Public cnn As New ADODB.CONNECTION
Public RST As New ADODB.Recordset
Public endR As Long, mySQLA As String

Sub ketnoixls()
On Error Resume Next
FName = ThisWorkbook.FullName
    If Application.Version < 12 Then
        cnnEx.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FName & _
                            ";Persist Security Info=true; Extended Properties=Excel 8.0;"
    Else
        cnnEx.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & FName & ";Extended Properties=""Excel 12.0;HDR=YES;"";"
    End If
'cnnEx.Close
End Sub

Sub ketnoixls_2()
On Error Resume Next
FName = "D:\Bao cao cua Hong\ListofCTKM.xlsm" 
    If Application.Version < 12 Then
        cnnEx.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FName & _
                            ";Persist Security Info=true; Extended Properties=Excel 8.0;"
    Else
        cnnEx.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & FName & ";Extended Properties=""Excel 12.0;HDR=YES;"";"
    End If
'cnnEx.Close
End Sub

Sub thứ 2:

Sub KiemtraCTKM_another_file()
    
    Set RSTEx = New ADODB.Recordset
    ketnoixls_2
    'On Error GoTo ErrorHandler
        'Dim s As String
        's = Worksheets("New_Order").Cells(2, 1) 'A2
        Dim DASheet As Worksheet
        
        Set DASheet = ThisWorkbook.Worksheets("New_Order")
        Dim lastRow As Long
        lastRow = DASheet.Cells(DASheet.Rows.Count, "A").End(xlUp).Row
        
                'Worksheets("New_Order").Range("AM11:O" & lastRow).Clear
                'Worksheets("New_Order").Range("A11" & lastRow).Interior.Pattern = xlNone
                'Worksheets("New_Order").Range("A11" & lastRow).Font.Color = vbBlack
        mySQLA = "SELECT a.[ProductID] FROM [CTKMa$] AS a" & _
            "WHERE a.[ProductID] = [New_Order$].[ProductID]"
            
        'On Error Resume Next
        RSTEx.Open mySQLA, cnnEx, adOpenKeyset, adLockOptimistic
        'Exit Sub
'ErrorHandler:
    'MsgBox "Error: " & Err.Description
        With DASheet
            
            For i = 0 To (RSTEx.Fields.Count - 1)
                .Cells(10, (i + 1)) = RSTEx.Fields(i).NAME
            Next
                .Range("AM11").CopyFromRecordset RSTEx
        End With
        'RSTEx.Close
    cnnEx.Close
    
End Sub

Tóm tắt cho dễ hiểu:
- File OrderList là file chứa mã sản phẩm, cũng là nơi mà chứa bộ code.
- File ListofCTKM là file chứa những mã sản phẩm đang chạy CTKM, có cột ngày bắt đầu ở AE, ngày kết thúc ở AF
- Tìm trong file ListofCTKM, những ProductID nào đang diễn ra CTKM điền vào trong file OrderList - điền vào cột AM và AN.
(Giống như dùng VLOOKUP, nhưng em lại dùng SQL để truy vấn ạ.)
--> Nhờ các bác hỗ trợ sửa giúp em ạ.

Bạn cần đăng nhập để thấy link

Bạn cần đăng nhập để thấy link