ADODB查询

'Public path As String

Sub adodb_test1()
'声明并初始化对象
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset

Rem 一、 建立连接

Rem 连接access数据库:
'With cnn
'    .Provider = "microsoft.ace.oledb.12.0"
'    .ConnectionString = "Data Source=带完整路径的access数据库名称"
'    .Open
'End With

Rem 连接excel：
With cnn
    .Provider = "microsoft.ace.oledb.12.0"
    .ConnectionString = "Data Source=C:\Users\21469\Desktop\ADODB.xlsm;Extended Properties=""Excel 12.0 Macro;HDR=YES;IMEX=1"""
    .Open
End With
If cnn.State = 1 Then
    MsgBox "连接成功！"
Else
    MsgBox "连接失败！"
End If


' 记得关闭连接
cnn.Close
Set cnn = Nothing

End Sub

Sub adodb_test2()
'声明并初始化对象-前期绑定
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strConn As String
Dim path As String
Dim strSql As String

'后期绑定

' Dim conn As Object
' Dim rs As Object
' Set conn = CreateObject("ADODB.Connection")
' Set rs = CreateObject("ADODB.Recordset")

path = ThisWorkbook.FullName

strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
      "Data Source=" & path & ";" & _
      "Extended Properties=""Excel 12.0;HDR=NO;IMEX=1"""

' hdr = Header，表示第一行是否包含列标题，no的话系统会自动生成列名（F1, F2, F3...）
' IMEX=1,强制将所有数据读为文本，避免数据类型混淆,适用于列中包含混合数据类型的情况

'打开连接
conn.Open strConn

' 构建SQL查询语句 - 查询sheet1的前四列（F1到F4）数据放到sheet2中
strSql = "SELECT F1, F2, F3, F4,F5 FROM [Sheet1$]"

'执行查询语句
Set rs = conn.Execute(strSql)

'将结果放到目标区域
Sheet2.Cells.Clear
If Not rs.EOF Then
    Sheet2.Range("A1").CopyFromRecordset rs
Else
    MsgBox "没有找到数据！"
End If

'关闭记录集和连接
rs.Close
conn.Close

'清空对象
Set rs = Nothing
Set conn = Nothing

End Sub

Sub ado_基础查询()
Rem 不打开文件抓取表格中的数据
'声明并初始化对象及链接
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strConn As String

Dim strSql As String

' Call 获取路径
path = "C:\Users\21469\Desktop\原始数据.xlsx"
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & path & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"""
'打开链接、查询信息和复制数据
'增删改查
' strSql1 = "select * from [data$]" '基础语句：*代表所有列，【表名$】代表从哪个表里查
' strSql2 = "select * from [data$] union all select * from [data2$]" '跨表合并（上下）
' strSql3 = "select 姓名,年龄 from [data$] where 性别='男'" '基础条件查询
' strSql4 = "select 姓名,年龄 from [data$] where 性别='男' union select 姓名,年龄 from [data2$] where 性别='男'" '跨表查询
' strSql5 = "insert into data$ values ('zhangxt','男',18)" '写入一条信息
' strSql6 = "update [data$] set 性别='男女',年龄=130 where 姓名='张三'" '修改一条数据，对excel文件无法删除一条数据
' strSql7 = "select [data$].姓名,性别,年龄,月薪 from [data$] left join [data3$] on [data$].姓名=[data3$].姓名" '左连接查询，连接查询中如果select的是单一字段名，则无需指定该字段来自哪个表或者查询
' strSql8 = "select [data$].姓名,性别,年龄,[data3$].月薪 from [data$] right join [data3$] on [data$].姓名=[data3$].姓名" '右连接查询
' strSql9 = "select [data$].姓名,年龄,[data3$].月薪 from [data$] inner join [data3$] on [data$].姓名=[data3$].姓名" '内连接查询
' strSql10 = "select a.姓名,性别,年龄,月薪 from (select * from [data$] union select * from [data2$])a left join [data3$] on a.姓名=[data3$].姓名" '先上下合并再连接查询
' strSql11 = "select [data$].姓名,[data$].性别,[data3$].月薪 from [data$] inner join [data3$] on [data$].姓名=[data3$].姓名 and [data$].性别=[data3$].性别" '多条件内查询
' select * from [sheet1$] where 姓名 like "张%" '通配符:ADO SQL 查询中：% 匹配0个或多个字符;_ 匹配恰好1个字符；VBA Like 运算符中：使用 * 匹配0个或多个字符，? 匹配单个字符
' select * from [sheet1$] where 部门='技术部' and 职位='工程师' and 入职日期<#2020/9/5# '注意日期型数据用#括起来
' select * from [sheet1$] where 姓名 is null 'select * from [sheet1$] where 姓名 is not null
' select * from [sheet1$] where 年龄 not between 20 and 35 '[not] between
' select * from [sheet1$] where 部门 not in ('技术部','市场部') '[not] in ( )
' select distinct 部门 from [sheet1$] 查询某个字段不重复信息，即对某个字段去重
' select 姓名,年龄 from [sheet1$] order by 年龄 desc '按照某字段排序，desc降序，默认升序asc
' group by 和having，having是对分组后的结果进行过滤，where是对原始数据进行过滤
' select 部门,AVG(年龄) from [sheet1$] group by 部门
' select 部门,职位,AVG(年龄) from [sheet1$] group by 部门,职位 同时按照两个字段分组
' select 部门,职位,AVG(年龄) as 平均年龄 from [sheet1$] group by 部门,职位 order by AVG(年龄) desc，注意order by 跟平均年龄报错了
' select 部门,职位,AVG(年龄) as 平均年龄 from [sheet1$] group by 部门,职位 having AVG(年龄)<=30 order by AVG(年龄) desc
' select top 10 部门,职位,AVG(年龄) as 平均年龄 from [sheet1$] group by 部门,职位 having AVG(年龄)<=30 order by AVG(年龄) desc

strSql = Range("P9")
conn.Open strConn
Set rs = conn.Execute(strSql)

Sheet1.Range("a1").CurrentRegion.Offset(1).Clear
Sheet1.Range("A2").CopyFromRecordset rs

'关闭并清空记录集和连接对象
rs.Close '执行写入或者修改语句时，则不需要本句，同时直接执行即可conn.Execute(strSql)
conn.Close
Set rs = Nothing
Set conn = Nothing
End Sub

Sub ado_其他属性副本()
Rem 不打开文件抓取表格中的数据
'声明并初始化对象及链接
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strConn As String
Dim path As String
Dim strSql As String

On Error GoTo ErrorHandler

path = "C:\Users\admin1\Desktop\原始数据.xlsx"
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
      "Data Source=" & path & ";" & _
      "Extended Properties=""Excel 12.0;HDR=Yes"""

'修正1：直接使用SQL查询语句，而不是从单元格读取
strSql = "select * from [sheet1$]"

conn.Open strConn
Set rs = conn.Execute(strSql)

'修正2：检查记录集是否为空
If rs.EOF And rs.BOF Then
    MsgBox "没有找到数据！"
    GoTo CleanUp
End If

'修正3：从第一条记录开始循环
rs.MoveFirst
i = 1

Do While Not rs.EOF
    '修正4：检查字段是否存在，使用字段名或索引
    '方法1：使用字段名（确保Excel中第一行有列标题"年龄"）
    If Not IsNull(rs.Fields("年龄").Value) Then
        Cells(i, 1) = rs.Fields("年龄").Value
    End If
    
    '或者方法2：使用字段索引（如果不知道字段名）
    'Cells(i, 1) = rs.Fields(0).Value '第一个字段
    
    i = i + 1
    rs.MoveNext
Loop

CleanUp:
'关闭并清空记录集和连接对象
If rs.State = adStateOpen Then rs.Close
If conn.State = adStateOpen Then conn.Close
Set rs = Nothing
Set conn = Nothing
Exit Sub

ErrorHandler:
MsgBox "错误 " & Err.Number & ": " & Err.Description
Resume CleanUp
End Sub

Sub 获取路径()

Dim filepath As String
Dim fileFilter As String

'定义文件过滤器
fileFilter = "Excel文件 (*.xlsx;*.xls),*.xlsx;*.xls," & _
            "文本文件 (*.txt),*.txt," & _
            "所有文件 (*.*),*.*"

filepath = Application.getopenfilename(fileFilter, 3, "选择你的文件")

If filepath = "False" Then Exit Sub
path = filepath

' MsgBox filepath
End Sub