Scribd Logo
Upload

Welcome to Scribd!

  • 4 views

    New Text Document

    Uploaded by

    echduy

    Copyright:

    © All Rights Reserved
    Download as TXT, PDF, TXT or read online from Scribd

    New Text Document

    Uploaded by

    echduy
    4 views1 page

    Original Title

    New Text Document (3)

    Copyright

    © © All Rights Reserved

    Available Formats

    TXT, PDF, TXT or read online from Scribd

    Did you find this document useful?

    Is this content inappropriate?

    Copyright:

    © All Rights Reserved
    Download as TXT, PDF, TXT or read online from Scribd
    Download as txt, pdf, or txt
    4 views1 page

    New Text Document

    Uploaded by

    echduy

    Copyright:

    © All Rights Reserved
    Download as TXT, PDF, TXT or read online from Scribd
    Download as txt, pdf, or txt
    You are on page 1of 1

    Sub getdata_LIMS_customized()

    Dim pathFile, SqlQuery, ConnString As String


    Dim Connect As New ADODB.Connection
    Dim RS As New ADODB.Recordset
    Dim lastRow As Long
    Dim inputSheet As Worksheet
    Dim columnList As Range
    Dim columnNames As String

    Set inputSheet = ThisWorkbook.Sheets("Input")


    Set columnList = inputSheet.Range("C7")
    columnNames = ""

    For Each cell In columnList


    If cell.Value <> "" Then
    columnNames = columnNames & "[" & cell.Value & "],"
    End If
    Next cell

    columnNames = Left(columnNames, Len(columnNames) - 1)

    lastRow = Sheets("Source").Cells(Rows.Count, 1).End(xlUp).Row


    pathFile = ThisWorkbook.FullName

    ConnString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & pathFile &


    ";Extended Properties=""Excel 12.0 Xml;HDR=YES"";"

    SqlQuery = "SELECT " & columnNames & " FROM [Data$]"

    Connect.Open ConnString
    RS.Open SqlQuery, Connect

    Sheets("Source").UsedRange.ClearContents

    Dim i As Integer
    For i = 1 To RS.Fields.Count
    Sheets("Source").Cells(1, i).Value = RS.Fields(i - 1).Name
    Next

    Sheets("Source").Range("A2").CopyFromRecordset RS

    Sheets("Source").Select
    Range("A1").Select

    ' T?o b?ng d? li?u


    Dim tbl As ListObject
    Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange,
    ActiveSheet.Range("A1").CurrentRegion, , xlYes)

    With tbl
    .Name = "DATALIMS"
    .Range.Columns.AutoFit
    End With

    RS.Close
    Connect.Close
    End Sub

    You might also like