原文地址：http://partydang.blog.163.com/blog/static/762680402011117395133/

这个程序的作用是检查ACCESS里面是否有存在的查询，如果不存在就创建一个 

Sub QuerDef_create()
    Dim db1 As Database'定义一个数据库变量
    Dim Quy1, myQuy As QueryDef'定义数据库中的查询变量
    Dim QuerySting As String'定义字符串
    Dim RS1 As Recordset'定义数据库表
    Dim isExist As Boolean'定义判断
    Dim icols As Integer
    Dim lastrow As Integer
    Set db1 = OpenDatabase(ThisWorkbook.Path & "\test.MDB")
    For Each myQRY In db1.QueryDefs
        If myQRY.Name = "查询temp" Then
            isExist = True
        End If
    Next
    QuerySting = "SELECT result.SAP_NO, Sum(result.FEE) AS FEE之合计 FROM result GROUP BY result.SAP_NO"
    If Not isExist Then    '不存在则建立之
        Set Quy1 = db1.CreateQueryDef(Name:="查询temp", sqltext:=QuerySting)
    Else   '存在，则设置查询条件
        Set Quy1 = db1.QueryDefs("查询temp")
        Quy1.Sql = QuerySting
    End If
    Set RS1 = Quy1.OpenRecordset(dbOpenDynaset)'用查询进行计算，将数据给予RS1数据表
    With RS1    '取得最大值
        .MoveLast
        lastrow = .RecordCount
        .MoveFirst
    End With    '+++++++++++++++++++++++++++++++++++++

    'With Worksheets("查询")
    'For icols = 0 To RS1.Fields.Count - 1
    '.Cells(1, icols + 1).Value = RS1.Fields(icols).Name
    'Next
    '.Range("A2").CopyFromRecordset RS1'Sorry it's old way,i will try a new way!

    'End With
    Dim i As Integer
    With Sheets("查询")    '++++++++++++++取得数据表的名头
        For i = 0 To RS1.Fields.Count - 1
            .Cells(1, i + 1).Value = RS1.Fields(i).Name
        Next
    End With    '++++++++++++++++++++++++++++++++++++++++++++++
    Dim k As Integer
    With RS1    '++++++++++++++++++++++开始取数据
        .MoveFirst
        For k = 1 To lastrow
            For i = 0 To RS1.Fields.Count - 1
                Sheets("查询").Cells(k + 1, i + 1).Value = .Fields(i)    '取得行数据
            Next i
            .MoveNext
        Next k

    End With
    db1.Close
End Sub