Copy data không cần mở file excel nguồn dùng DAO (1 người xem)

[dpx2007]

Dear Everyone

E có vấn đề như thế này muốn nhờ các bác trên diễn đàn giúp đỡ. Xin cảm ơn các bác nhiều
- E muốn copy từng đơn vị dữ liệu(cell) của một vùng dữ liệu của file excel gốc(dữ liệu ở các cell là bất kỳ(text, numeric, date, space...) nghĩa là không đc tổ chức theo quy chuẩn của CSDL) sử dụng DAO để lấy dữ liệu của file đóng(không cần mở file nguồn).(Mục đích lấy dữ liệu từ file đóng)
- Hiện tại e cũng đã làm được việc này bằng cách mỗi lần copy 1 cell lại phải mở-đóng kết nối database, làm như vậy sẽ giảm tốc độ xử lý khi số lượng cell cần copy lớn và khi copy phải thực hiện mở-đóng rất nhiều lần cho một file. Ở đây e cũng kèm cả file ví dụ(1 file dữ liệu vd, 1 file thực hiện macro) đã làm việc này và code bên dưới.

Không biết các bác có cách nào khi copy dữ liệu thì chỉ cần mở-đóng kết nối 1 lần cho mỗi file sau đó xử lý dữ liệu đó tùy theo mục đích riêng không? xin các bác chỉ giúp.

Nếu dùng Copyrecordset hay GetRow thì dữ liệu file gốc phải được tổ chức theo chuẩn của CSDL, field nào thì phải định dạng đúng cho field đó thì mới copy đầy đủ được, nếu là dữ liệu tự do thì trong mỗi cột dữ liệu sẽ bị định dạng theo loại dữ liệu nào xuất hiện nhiều nhất. Nên trong trường hợp này không dùng được.

Sub GetData()
    'requires a reference to the Microsoft Scripting Runtime
    Dim FName As Variant
    Dim N, i As Integer
    
    On Error Resume Next
    SaveDriveDir = CurDir
    ChDrive MyPath
    ChDir MyPath
    
    FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", MultiSelect:=True)
    If IsArray(FName) Then
        For N = LBound(FName) To UBound(FName)
            For i = 1 To 9
                With Range("A500").End(xlUp)
                    .Offset(1, 0) = FName(N)
                    .Offset(1, 1) = GetValue(FName(N), 1, i, 1)
                    .Offset(1, 2) = GetValue(FName(N), 1, i, 2)
                    .Offset(1, 3) = GetValue(FName(N), 1, i, 3)
                End With
            Next i
        Next N
    End If
    
End Sub

Private Function GetValue(SourceFile As Variant, iSheet As Integer, iRow As Integer, iCol As Integer) As Variant
  'requires a reference to the Microsoft ActiveX Data Objects library
  'Variables for DAO
   Dim DAOstr As String
   Dim SQLstr As String
   Dim DAOdb As DAO.Database
   Dim DAOrs As DAO.Recordset
   Dim SourceRange As String
   Dim SourceSheet As String
   
    'Lay ten sheet cua closed workbook
    'For f = 0 To db.TableDefs.Count - 1
        'Debug.Print db.TableDefs(f).Name
    'Next f
   
   'Create the connection and query strings
    DAOstr = "Excel 8.0;HDR=No;"
    Set DAOdb = OpenDatabase(SourceFile, False, True, DAOstr)  'write/read
    
    'quy doi ra Range "D1:D1" chang han
    SourceRange = Cells(iRow, iCol).Address(False, False) & ":" & Cells(iRow, iCol).Address(False, False)
    'lay ten sheet
    SourceSheet = DAOdb.TableDefs(iSheet - 1).Name
    
    SQLstr = "SELECT * FROM [" & SourceSheet & SourceRange$ & "]"
    
  'Launching DAO
    On Error Resume Next
    
    Set DAOrs = DAOdb.OpenRecordset(SQLstr)
    
    'While Not DAOrs.EOF
          'For x = 0 To DAOrs.Fields.Count - 1
              GetValue = DAOrs.Fields(0).Value
          'Next
          'DAOrs.MoveNext
    'Wend
    
    'Close connection
    DAOrs.Close
    Set DAOrs = Nothing
    DAOdb.Close
    Set DAOdb = Nothing
End Function

​