请帮忙看看模块报错，是什么原因

123shusheng

我使用 Henry D. Sy的模块，将表导入excl表，黄色的地方是报错的，我不知道是哪没设好，请高手指点一下，谢谢！

'---------------------------------------------------------------------------------------
' 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, ByVal Hval As Integer, ByVal Lval As Integer)
' 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中的列表名
     objXL.Run "清空EXCL表"

    For intCol = 0 To rs.Fields.Count - 1  '是获取表中的列数
        Set fld = rs.Fields(intCol)
        objWs.Worksheets(strShtName).Cells(Hval, intCol + Lval) = fld.Name  'Excel中（1，1）开始输入列名
    Next intCol
    ' Now the actual data　现在开始复制数据
    intRow = Hval + 1      '你可以修改intRow从第几行开始输入数据，本例中是从第2行开始复制数据
    Do Until rs.EOF       '你可以修改intCol + 1从第几列开始输入数据，本例中是从第2行第1列开始复制数据
        For intCol = 0 To rs.Fields.Count - 1
          objWs.Worksheets(strShtName).Cells(intRow, intCol + Lval) = _
            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

123shusheng

找到问题了，我要导出的表有一个字段误设为了二进制格式，所以当表内没有内容时可以导出，但当有内容时就无法正常导出。