Office中国论坛/Access中国论坛

标题: 导出EXCEL的奇怪问题，通过日期查询能导出，其它条件查询导出是空的 [打印本页]

作者: daviee 时间: 2019-4-28 07:41
标题: 导出EXCEL的奇怪问题，通过日期查询能导出，其它条件查询导出是空的
参照网上的导出EXCEL的方法，通过查询后逐条遍历导出的方法，查询是平台生成的通用查询模块，不同的条件能查询出结果，但是在导出到EXCEL时，只有通过日期查询才能导出到EXCEL,通过其它条件查询，导出的EXCEL表是空的。。。，因为要控制导出的结果，所以用的是逐条遍历导出的方法。不知道下面的代码哪出错了。 (, 下载次数: 36)

Private Sub cmdExport_Click()
On Error GoTo Err_Show

Dim rs As Object
Dim xlApp As Object    'Excel.Application
Dim xlBook As Object 'Excel.Workbook
Dim xlSheet As Object 'Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add '添加一个新的Book
Set xlSheet = xlApp.ActiveSheet    '使用当前的Sheet
Dim i As Long
Dim j, ii As Long
Dim strExcelName As String
Dim strPath As String
Dim strSql As String
Dim cn As Object

'【事务处理】
Set cn = CurrentProject.Connection
cn.BeginTrans          '开始事务

strSql = Me.sfmSubForm.Form.RecordSource

If InStr(1, strSql, "Select") = 0 Then strSql = "select * from " & strSql & ";"
If Me.sfmSubForm.Form.FilterOn = True Then
      strSql = Replace(strSql, ";", "") '去掉;号
      strSql = "select * from (" & strSql & ") as qryA where " & Me.sfmSubForm.Form.Filter
End If

Set rs = gf_OpenRecordset(strSql, cn, 1, 1)

'先写入标题(可以考虑用DAO的字段标题属性 rs(i-1).Properties("Caption"))
For i = 1 To 12
' For i = 1 To rs.Fields.Count
      xlSheet.Cells(1, i) = rs(i - 1).Name
Next

'写入数据，从第2行开始写数据
      ii = 1
      Do While Not rs.EOF
         xlSheet.Cells(1 + ii, 1) = rs("供应商")
         xlSheet.Cells(1 + ii, 2) = rs("快递日期")
   '    xlSheet.Cells(1 + ii, 3) = rs("销售单号")
         If rs("数量") > 0 Then xlSheet.Cells(1 + ii, 3) = rs("销售单号") Else xlSheet.Cells(1 + ii, 3) = ""
         xlSheet.Cells(1 + ii, 4) = rs("客户料号")
         xlSheet.Cells(1 + ii, 5) = rs("产品料号")
         xlSheet.Cells(1 + ii, 6) = rs("描述")
         xlSheet.Cells(1 + ii, 7) = rs("单位")
         xlSheet.Cells(1 + ii, 8) = rs("数量")
         xlSheet.Cells(1 + ii, 9) = rs("快递单号")
         xlSheet.Cells(1 + ii, 10) = rs("快递公司")
         xlSheet.Cells(1 + ii, 11) = rs("收货工厂")
         xlSheet.Cells(1 + ii, 12) = rs("备注")
         rs.MoveNext
         ii = ii + 1
      Loop
rs.Close
xlApp.Visible = True

For j = 1 To 12
      xlSheet.Cells(1, j).Interior.ColorIndex = 45 '填充颜色为橙色
Next

xlApp.Range("A1" & ii).Borders.LineStyle = 1

strExcelName = Me.Caption & Format(Date, "_yyyymmdd")

'调整列宽
xlSheet.Columns.EntireColumn.AutoFit
xlApp.Visible = True
xlBook.Activate
' ExportToExcel = True
xlApp.Worksheets(1).Name = Me.Caption & Format(Date, "_yyyymmdd")    'SHEET名称

DoCmd.SetWarnings False
With xlApp.Application.FileDialog(msoFileDialogSaveAs)
.Title = "请保存文件"
.ButtonName = "保存"
.InitialView = msoFileDialogViewDetails
.InitialFileName = "C:\Users\Administrator\DeskTop\" & Me.Caption & Format(Date, "yyyymmdd") & " .xls"
If .Show = -1 Then
xlBook.SaveAs Me.Caption & Format(Date, "yyyymmdd") & " .xls"
Else
Debug.Print "用户取消"
End If
End With

Err_Exit:
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Set rs = Nothing
Exit Sub
Err_Show:
MsgBox "导出出错，请重新尝试" & vbCrLf & Err.Description, "导出出错"
On Error Resume Next
'出错则清掉文件，避免有多个Excel进程
xlBook.Close False
If xlApp.Workbooks.Count = 0 Then xlApp.Quit
GoTo Err_Exit
End Sub

作者: tmtony 时间: 2019-4-28 10:21
Do While Not rs.EOF
在这一句前面加上
msgbox rs.recordcount
看看有否数据

作者: daviee 时间: 2019-4-28 12:31

tmtony 发表于 2019-4-28 10:21
Do While Not rs.EOF
在这一句前面加上
msgbox rs.recordcount

通过日期查询导出时，有数据记录，但是选其它条件查询导出时，0记录

作者: daviee 时间: 2019-5-4 09:40
检查发现是这段出问题

  If Me.sfmSubForm.Form.FilterOn = True Then
      strSql = Replace(strSql, ";", "") '去掉;号
      strSql = "select * from (" & strSql & ") as qryA where " & Me.sfmSubForm.Form.Filter
End If
qryA是查询模块中的一个变量，改不了。重新把这个导出EXCE的过程做成为一个函数，解决了这个问题。

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)