请问VBA中有没有能使用SQL语句的模版？

jjxx2005

Sub MakeExcelQT()
        Dim sConn As String
        Dim sSQL As String
        Dim oQt As QueryTable
        Dim sh As Worksheet
        sConn = "ODBC;DSN=Excel Files;DBQ=C:\SQL.xlsx;"
        sConn = sConn & "DefaultDir=Z:;DriverId=1046;"
        sConn = sConn & "MaxBufferSize=2048;PageTimeout=5;"
        sSQL = "SELECT * FROM [Sheet1$] ordey by 成绩"
        Set sh = ThisWorkbook.Worksheets.Add
        Set oQt = sh.QueryTables.Add(sConn, sh.Range("A1"), sSQL)
        oQt.Refresh


我从网上找了好多模就没有能用的，当然不能说一点不能用，有些模版不支持

SELECT [姓 名] , [as]  FROM [Sheet1$]      # 不支持字段带空格的这种方式

SELECT f2 as 姓名,f3 as 性别FROM [学生表$]  # 不支持无字段名的这种方式

SELECT 字段名 FROM 表名 ORDEY BY 字段名 ASC    # 不支持排序

等等 反正各种不支持，请问有没有能支持SQL语句的，其实我的语句并不复杂  总提示语法错误

zhshbding

1. Sub Query()
   
2.     Dim Conn As Object, Rst As Object
   
3.     Dim strConn As String, strSQL As String
   
4.     Dim i As Integer, PathStr As String
   
5.     Set Conn = CreateObject("ADODB.Connection")
   
6.     Set Rst = CreateObject("ADODB.Recordset")
   
7.     PathStr = ThisWorkbook.FullName   '设置工作簿的完整路径和名称
   
8.     t = ActiveSheet.Name
   
9.     Select Case Application.Version * 1    '设置连接字符串,根据版本创建连接
   
10.     Case Is <= 11
    
11.         strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
    
12.     Case Is >= 12
    
13.         strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    
14.     End Select
    
15.     '设置SQL查询语句
    
16.     strSQL = "select * from [" & t & "$] where "
    
17.     Conn.Open strConn    '打开数据库链接
    
18.     Set Rst = Conn.Execute(strSQL)    '执行查询，并将结果输出到记录集对象
    
19.     'ThisWorkbook.Sheets.Add after:=Worksheets("数据源") '添加一个新工作表在第一工作后
    
20.     For Each ws In Worksheets
    
21.         If ws.Name = "提数结果" Then ws.Delete
    
22.     Next
    
23.     Sheets.Add.Name = "提数结果"
    
24.     With Sheets("提数结果")
    
25.         .Cells.Clear
    
26.         .Tab.Color = 255
    
27.         For i = 0 To Rst.Fields.Count - 1    '填写标题
    
28.             .Cells(1, i + 1) = Rst.Fields(i).Name
    
29.         Next i
    
30.         .Range("A2").CopyFromRecordset Rst
    
31. '        .Cells.EntireColumn.AutoFit  '自动调整列宽
    
32.     End With
    
33.     Rst.Close    '关闭数据库连接
    
34.     Conn.Close
    
35.     Set Conn = Nothing
    
36.     Set Rst = Nothing
    
37. End Sub

复制代码

jjxx2005

zhshbding 发表于 2020-3-28 11:01

谢谢您 太感谢了

xiangbaoan

ORDEY  什么东东? 该是ORDER吧。