将带有结果的多个查询导出到 Excel 到一个工作表中

Posted 2023-03-24

【中文标题】将带有结果的多个查询导出到 Excel 到一个工作表中

【英文标题】：Export multiple queries with results to Excel into one worksheet

【发布时间】：2019-04-04 13:36:40

【问题描述】：

我想将我的数据库中所有以“WWEI”开头的有记录的查询导出到一个 Excel 工作表中，并在彼此下方列出。

strFullPath = "C:\Users\test.xlsx"
Set wb = xl.Workbooks.Add
Set wb = xl.Workbooks.Open(strFullPath)   
Set ws = wb.Worksheets(1)      
Set r = ws.Range("a1")         
r = "Possible Mistakes"

Set r = r.Offset(2, 1)

For Each qdf In CurrentDb.QueryDefs
    If Mid(qdf.Name, 1, 4) = "WWEI" Then
        querybezeichnung = qdf.Name
        If DCount("*", querybezeichnung) > 0 Then

            Set rs = CurrentDb.OpenRecordset(querybezeichnung)
            With rs
                For i = 1 To .Fields.Count
                    r.Cells(1, i) = .Fields(i - 1).Name
                    r.Cells(1, i).Font.Bold = True
                    'r.Cells(1, i).AutoFilter
                Next i
            End With
            Set r = r.Offset(1, 0)

            r.CopyFromRecordset rs
            rs.Close
            Set r = r.End(xlDown).Offset(2, 0)

        End If
    End If
Next qdf

我在线出现运行时错误“1004”：

Set r = r.End(xlDown).Offset(2, 0)

【问题讨论】：

querybezeichnung 是我之前声明的字符串

Set r = r.End(xlDown).Offset(2, 0) 因此你应该避免使用xlDown。假设r 是[a1]，然后在单元格A1 之后什么都没有。当你说r.End(xlDown)。您指的是最后一个单元格（在 Excel 2007+ 的情况下为 A1048576，在 Excel 2003 的情况下为 A65536），然后最重要的是，您告诉 Excel 超过 2 行......显然 excel 会给你错误。使用xlUp 找到最后一行，然后做你想做的事。请参阅This 了解如何找到最后一行。

感谢您的提示，我解决了这个问题：Dim lngLastRow As Long With r.Worksheet lngLastRow = .Cells(.Rows.Count, r.Column).End(xlUp).Row .Range (.Cells(lngLastRow + 1, 1), .Cells(.Rows.Count, 1)).EntireRow.Delete End With Set r = r.Offset(lngLastRow, 0)

【参考方案1】：

Set r = r.End(xlDown).Offset(2, 0)
 instead of dis can't you use
Set r = r.Offset( recordcountofrs + 2, 0)
'________________________________________________________
strFullPath = "C:\Users\test.xlsx"
Set wb = xl.Workbooks.Add
Set wb = xl.Workbooks.Open(strFullPath)   
Set ws = wb.Worksheets(1)      
Set r = ws.Range("a1")         
r = "Possible Mistakes"

Set r = r.Offset(2, 1)

For Each qdf In CurrentDb.QueryDefs
    If Mid(qdf.Name, 1, 4) = "WWEI" Then
        querybezeichnung = qdf.Name
        If DCount("*", querybezeichnung) > 0 Then

            Set rs = CurrentDb.OpenRecordset(querybezeichnung)
            With rs
                For i = 1 To .Fields.Count
                    r.Cells(1, i) = .Fields(i - 1).Name
                    r.Cells(1, i).Font.Bold = True
                    'r.Cells(1, i).AutoFilter
                Next i
            End With
            Set r = r.Offset(1, 0)

            r.CopyFromRecordset rs
        LstRow = rs.RecordCount '<== this line added 
            rs.Close
            Set r = r.Offset(LstRow+2, 0) '<== this line changed 

        End If
    End If
Next qdf