2021-01-20

Mysql查询excel表

Sub Query()
Dim Conn As Object, Rst As Object
Dim strConn As String, strSQL As String
Dim i As Integer, PathStr As String
Set Conn = CreateObject("ADODB.Connection")
Set Rst = CreateObject("ADODB.Recordset")
PathStr = "C:\Users\00386155\Documents\终端特陈1101-1130.xlsx"
t = ActiveSheet.Name
Select Case Application.Version * 1 '设置连接字符串,根据版本创建连接
Case Is <= 11
    strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
Case Is >= 12
    strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties = ""Excel 12.0;HDR=YES"";"""
End Select
'设置SQL查询语句
strSQL = "select * from [特陈整理档$]"
Conn.Open strConn '打开数据库链接
Set Rst = Conn.Execute(strSQL) '执行查询，并将结果输出到记录集对象
'ThisWorkbook.Sheets.Add after:=Worksheets("数据源") '添加一个新工作表在第一工作后
For Each ws In Worksheets
    If ws.Name = "提数结果" Then ws.Delete
Next


Sheets.Add.Name = "提数结果"
With Sheets("提数结果")
    .Cells.Clear
    .Tab.Color = 255
For i = 0 To Rst.Fields.Count - 1
    .Cells(1, i + 1) = Rst.Fields(i).Name
Next i
    .Range("A2").CopyFromRecordset Rst
    .Cells.EntireColumn.AutoFit '自动调整列宽
End With
Rst.Close '关闭数据库连接
Conn.Close
Set Conn = Nothing
Set Rst = Nothing
'填写标题
End Sub