在VBA中使⽤SQL处理数据
Sub使⽤sql处理数据()
Application.ScreenUpdating =False
'创建数据库相关对象
'创建数据库连接
Dim Cnn As Object
Set Cnn = CreateObject("ADODB.Connection")
'创建包含描述数据源模式⽬录的集合
Dim MyCat As Object
Set MyCat = CreateObject("ADOX.Catalog")
'创建⼀个数据集保存数据
Dim rst As Object
Set rst = CreateObject("dset")
'设置数据库连接
Dim strConn$
strConn ="Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=excel 12.0;Data Source="
Cnn.Open strConn & ThisWorkbook.FullName
'遍历⽂件夹，处理数据
Dim sql$, SheetName$, r&
Dim ph$, f$
vba数据库编程ph = ThisWorkbook.Path & "\"  '路径
f = Dir(ph &"*.xlsx")'⽂件名
Do While f <>""'循环所有⽂件
If(f <> ThisWorkbook.Name)*(f <>"0030.xlsx")Then'如果不是本⽂件，进⾏提取
MyCat.ActiveConnection = strConn & ph & f
SheetName = Replace(MyCat.Tables(0).Name,"'","")'替换表名中的单引号
'写SQL
sql = "select* from [Excel 12.0;Hdr=no;Database=" & ph & f & "].[" & SheetName & "]" '获取第1列：f1 或 [第⼀列的列名]"
'sql = "select f1,f3 from [" & SheetName & "] where f1 is not null" '获取第1列：f1 或 [第⼀列的列名]
'执⾏SQL
rst.Open sql, Cnn,3,1
'填充数据
r = Range("a"& Rows.Count).End(xlUp).Row +1
Range("a"& r).Resize(rst.RecordCount)="'"&Left(f, InStrRev(f,".")-1)'  '去除⼯作簿后缀名，填充在“A”列
Range("b"& r).CopyFromRecordset rst '查询结果
rst.Close
End If
f = Dir
Loop
Cnn.Close
Application.ScreenUpdating =True
End Sub

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。