求助QueryToExcel （输出到EXCEL）碰到的问题

asklove

Henry D. Sy　写的ACCESS查询所得数据输入到EXCEL指定位置非常好用！

现碰到一个问题：Balance这个查询如果带有条件格式（例根据窗体上的某个控件查询所得）就会出错
（运行时错误'*****'　无效的SQL语句；期待****）
rs.Open strQueryName, CurrentProject.Connection
改成　rs.Open "select * from " & strQueryName, CurrentProject.Connection,1,1 也一样
该如何解决，望得到高手的帮助，谢谢
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Private Sub Command0_Click()
    QueryToExcel "Balance", "balxls", "bal"  '实际使用命令格式
    'Balance 是　你建的查询名称
    'balxls  是　Excel工作表名称
    'bal     是  Excel工作表balxls中的工作簿名称
End Sub
'---------------------------------------------------------------------------------------
' Procedure : QueryToExcel
' DateTime  : 2008-12-2 00:02
' Author    : Henry D. Sy
' Purpose   :
'---------------------------------------------------------------------------------------
'
Sub QueryToExcel(ByVal strQueryName As String, ByVal xlsName As String, ByVal _
                                                                        strShtName As String)
' Send the Query results to Excel
' for further analysis
    Dim rs As ADODB.Recordset
    Dim objXL As Excel.Application
    Dim objWs As Excel.Workbook
    Dim fld As ADODB.Field
    Dim intCol As Integer
    Dim intRow As Integer

Set rs = New ADODB.Recordset
    ' Get the desired data into a recordset
   rs.Open strQueryName, CurrentProject.Connection
    ' Launch Excel
   Set objXL = New Excel.Application
    ' Open a  worksheet
    Set objWs = objXL.Workbooks.Open(CurrentProject.Path & "\" & xlsName & _
                                     ".xls")
    objWs.Worksheets(strShtName).Activate
    ' Copy the data　
    ' First the field names　第一行是ACCESS中的列表名
   
    For intCol = 0 To rs.Fields.Count - 1  '是获取表中的列数
        Set fld = rs.Fields(intCol)
        objWs.Worksheets(strShtName).Cells(1, intCol + 1) = fld.Name  'Excel中（1，1）开始输入列名
    Next intCol
    ' Now the actual data　现在开始复制数据
    intRow = 2            '你可以修改intRow从第几行开始输入数据，本例中是从第2行开始复制数据
    Do Until rs.EOF       '你可以修改intCol + 1从第几列开始输入数据，本例中是从第2行第1列开始复制数据
        For intCol = 0 To rs.Fields.Count - 1
            objWs.Worksheets(strShtName).Cells(intRow, intCol + 1) = _
            rs.Fields(intCol).Value
        Next intCol
        rs.MoveNext
        intRow = intRow + 1
    Loop
    ' Make the worksheet visible
    objXL.Visible = True '打开Excel表查看数据
    rs.Close
    Set rs = Nothing
End Sub

ACMAIN_CHM

至少贴一下你出错时的 strQueryName 是什么吗，否则很难再现你的错误。


******************
*  一切皆有可能  *
******************
.
ACMAIN - Access论坛回贴准则（个人）.
.
同一贴子不回复第二次
.
QQ群 48866293 / 12035577 / 7440532 / 13666209
http://www.office-cn.net/vvb/ .
http://www.accessbbs.cn/bbs/index.php .
http://www.accessoft.com/bbs/index.asp .
http://www.access-programmers.co.uk/forums .
.
http://www.office-cn.net/home/space.php?uid=141646 .

asklove

例　查询表A－SQL语句:select * from 表A　或者　select * from 表A where 姓名＝'汪汪'
      QueryToExcel "查询表A", "工作表", "sheet1"  能顺利导入EXCEL工作表中

但　查询表A－SQL语句变为：select * from 表A where 姓名＝[from]![窗体]![text1]
　　就会出错（运行时错误'*****'　无效的SQL语句；期待****）
　　
二者的区别就是下面的查询表A－where (条件中引用窗体上的控件),我碰到的就是这个问题

Henry D. Sy写的这个非常实用，自己加二个参数，以后可以直接导入到指定EXCEL表－工作簿－行列
(QueryToExcel "查询表A", "工作表", "sheet1","1","4")
现在就是　where (引用窗体上的控件)会出错，望能修改一下，方便我们小菜的使用啊

好像在EXCEL中导入ACCESS数据也是，只要查询表条件中引用窗体上的某个控件那么将看不到这个查询
录制成宏，修改查询名称也一样会出错。

asklove

我做个例子你看看

Henry D. Sy

1. Private Sub Command5_Click()
   
2.     Dim Qdf As DAO.QueryDef
   
3.     Dim strSQL As String
   
4.     Set Qdf = CurrentDb.QueryDefs("查询2")
   
5.     If IsNull(Me.Text0) Then
   
6.         strSQL = "select * from 表1"
   
7.     Else
   
8.         strSQL = "select * from 表1 where 姓名='" & Me.Text0 & "'"
   
9.     End If
   
10.     Qdf.SQL = strSQL
    
11.     Qdf.Close
    
12.     Set Qdf = Nothing
    
13.     QueryToExcel "查询2", "工作表", "sheet1"
    
14. End Sub

复制代码

asklove

谢了6D
永久珍藏