Using VBA to pull in data from separate workbook based on specific column order

Bronze Contributor

Dec 13, 2022

Function LjsAdo()
    On Error Resume Next '忽略错误
    Application.ScreenUpdating = False '停止屏幕刷新
    Application.DisplayAlerts = False '关闭报警窗口
    Dim myCN As Object ' 定义连接函数对象
    Dim myRS As Object '定义记录集对象
    Dim FilePath As String, SQLstr As String '定义文件路径和SQL语句变量
    Dim i As Long
    Set myCN = CreateObject("Adodb.Connection")
    '--------------------------------------------------
    FilePath = ThisWorkbook.FullName '定义本表文件名（包含路径）为目标文件路径
    SQLstr = "select format,css_class from [results$]" ' WHERE 姓名 like '%赵%' OR 姓名='马五' AND 年龄>20表名使用中括号加dollar符号表示，标题名称不需要使用引号。
    'SQLstr = "INSERT INTO [DB$] (姓名,年龄,性别,籍贯,备注) VALUES ('阳冬',32,'男','青海','本科')" 'VALUES连接要插入的字段和字段值，同样字段名称不需要引号。
    'SQLstr = "UPDATE [DB$] SET 备注 = '本科' WHERE 备注 = '大学'"
    myCN.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & FilePath & "; Extended Properties='Excel 12.0; HDR=YES; IMEX=3'" 'HDR 是否有标题；IMEX，013，写读读写
    Set myRS = myCN.Execute(SQLstr)
    With Sheet2
        .Cells.Clear
        For i = 0 To myRS.Fields.Count - 1    '填写标题
            .Cells(1, i + 1) = myRS.Fields(i).Name
        Next i
        .Range("A2").CopyFromRecordset myRS'拷贝数据
        '.Cells.EntireColumn.AutoFit  '自动调整列宽
    End With
    myCN.Close
    '---------------------------------------------------------
    Set myCN = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Function

grab that data by the header with ado api and sql.

Forum Discussion

Using VBA to pull in data from separate workbook based on specific column order

Resources