|
我好像遇到了同样的问题,求助
Sub DoSql_Execute1()
Dim TT
TT = Timer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Sql1 As String, Sql2 As String, Sql3 As String, Sql4 As String, Sql5 As String, Sql6 As String, Sql7 As String, Sql8 As String
Dim a
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.InitialFileName = ThisWorkbook.Path
If .Show = 0 Then
MsgBox ("已取消打开文件,并清空本工作薄"): Exit Sub '判断是否打开文件,点击确定返回-1,点击取消返回0,若返回0 则取消打开文件,显示弹窗并停止运行。
Else
Sheets(2).Select
Set a = Workbooks.Open(.SelectedItems(1))
a.Sheets(1).AutoFilterMode = False
a.Sheets(1).Range("A:XFD").Copy ThisWorkbook.Sheets(2).Range("A1")
a.Close False
End If
End With
Dim cnn As Object, rst As Object
Dim Mypath As String, Str_cnn As String, Sql As String
Dim i As Long
Set cnn = CreateObject("adodb.connection")
'以上是第一步,后期绑定ADO
'
Mypath = ThisWorkbook.FullName
If Application.Version < 12 Then
Str_cnn = "Provider=Microsoft.jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & Mypath
Else
Str_cnn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & Mypath
End If
cnn.Open Str_cnn
'以上是第二步,建立链接
Sql = "SELECT a,b,c,d,e FROM [sheet2$] where e>" & Sql1 & " and (c>" & Sql2 & " or d>" & Sql3 & ") ORDER BY e DESC "
'Sql语句,查询Sheet1表成绩大于80……姓名和成绩的记录
Set rst = cnn.Execute(Sql)
'cnn.Execute()执行SQL语句,始终得到一个新的记录集rst
'以上是第三步,编写并使用SQL语句
'
Sheets(3).Select
[a:z].ClearContents
'清空[d:e]区域的值
For i = 0 To rst.Fields.Count - 1
'利用fields属性获取所有字段名,fields包含了当前记录有关的所有字段,fields.count得到字段的数量
'由于Fields.Count下标为0,又从0开始遍历,因此总数-1
Cells(1, i + 1) = rst.Fields(i).Name
Next
Range("a2").CopyFromRecordset rst
'使用单元格对象的CopyFromRecordset方法将rst内容复制到D2单元格为左上角的单元格区域
'以上是第四步,将SQL查询结果和字段名写入表格指定区域
Columns("A:A").Select
Selection.NumberFormatLocal = "yyyy/m/d h:mm"
Range("a1").Select
cnn.Close
'关闭链接
Set cnn = Nothing
'释放内存
MsgBox ("完成!并已另存为新工作薄!" & vbCrLf & "保存路径为宏工具所在位置" & vbCrLf & "用时:" & Format(Timer - TT, "#0.00") & " 秒")
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
|
|