access数据导入到excel中的sql

Question

.....
....
....
xPath = App.Path & "\backupDelete\" & Replace(CStr(Now), ":", "_") & tableNameDLTDLT & ".xls"
VBExcel.Workbooks(1).SaveAs xPath
VBExcel.Workbooks(1).Close
VBExcel.Quit
Set VBExcel = Nothing 
'excel创建成功
'接下来对该excel插入在access中查询到符合条件的记录
Z$ = " from MeBack where f1>10 and f2=5"
sql = "select * INTO OPENDATASOURCE('microsoft.Jet.OLEDB.4.0','Data Source=""" & xPath & """;User ID=Admin;Password=;Extended Properties=Excel 8.0')..." & "[sheet1$]"
sql = sql & Z$
Dim conn As New ADODB.Connection
conn.CursorLocation = adUseClient
connstr = "provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=2543;Persist Security Info=False;Data Source=" + App.Path + "\sale.mdb"
conn.Open connstr
conn.Execute strSQL
conn.Close
msgbox "ok!"xPath 经检查路径没错 ,这个excel是新建的,里面没有任何记录但存在sheet1$怀疑Z$ = " from MeBack where f1>10 and f2=5"是从access中导出有条件的数据出错也曾经怀疑xpPath中的now可能因为执行中会改变而找不excel文件,但检查过,没问题报错:查询输入必须包含至少一个表或查询请高手指点

Answer 1

OPENDATASOURCE函数错误,ACCESS不支持这个函数,SQLSERVER的函数

Answer 2

不是只是指出错误啊,后台是用access
但是记录我不希望一条一条来导到excel,不会是个不可能的事情吧
虽然是小程序,但是我希望尽我所能效率做得最好
所以才深夜发帖求你们的

Answer 3

打印函数
Public Function PrintInExcelRst(ByVal rst)
    If rst.RecordCount > 0 Then
        rst.MoveFirst
        Dim i As Integer
        Dim j As Integer
        Dim newXls As Excel.Application
        Dim newBook As Excel.Workbook
        Dim newSheet As Excel.Worksheet
        Set newXls = CreateObject("Excel.Application")
        newXls.Visible = True
        Set newBook = newXls.Workbooks.Add
        Set newSheet = newBook.Worksheets(1) '创建工作表
        For i = 0 To rst.RecordCount - 1
            For j = 0 To rst.Fields.Count - 1
               
                
                    newSheet.Cells(i + 1, j + 1) = rst(j)
              
            Next j
            rst.MoveNext
        Next i
    End If
 
End Function

Answer 4

许仙 你的那种我已经写了出来的是一个cell一个cell地导到excel的
如如果有几千条记录要导出到来,效率会很低的啊我现在要求高效率啊,想一批来

Answer 5

结果是一句sql语句把3w多的记录3秒内删除并新建excel来导入.邹老大说这个是access比sql强的地方,我终于领到了效果.我还听说access在交错汇总上比sql强的,要试一下了.