访问VBA将2个表导出到一个excel，并符合条件

我已经测试和搜索了几个星期，我想现在是时候在数百次测试之后寻求帮助了。这是我的情况

我在MS Access中有两个表：

Journal\u personeel\u verloning

（或

表1

）

• 表1有几个员工，比如说：5个不同的员工

• 表1列出了工作时间的详细信息示例：每天工作时间从到小时

Journal\u personeel\u verloning\u 2\u all

（或

表2

）

• 表2也有几个员工，比如说：5个不同的员工

• 表2列出了每个员工当月的总工作时间

注:

• 表1和表2的员工始终完全相同

• Persid

  是应该过滤的字段名（两个表都有此字段名）

---

我想实现什么：我想在以下条件下将两个表导出到一个Excel文件：

• 1个Excel文件，包含2个表的数据
• 每个

  PersID

  在单独的表单/选项卡上
• 每个工作表/选项卡名称应为

  PersID

问题

我编写了一个代码，可以很好地处理

表1

。当我对

表2执行相同操作时，它将被覆盖。因此，每次我都有一个表的数据，而不是每个表/选项卡上两个表的数据，其中包含总共两个表的数据

我复制了
表2的代码。如果重命名Excel输出文件，当然会得到两个单独的文件：

Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rstMgr As DAO.Recordset
Dim strSQL As String, strTemp As String, strMgr As String
-----------------

Const strFileName As String = "Employee_Verloning"

DoCmd.SetWarnings False


Const strQName As String = "zExportQuery"

Set dbs = CurrentDb
strTemp = dbs.TableDefs(0).Name

strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"

Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close

strTemp = strQName

strSQL = "SELECT DISTINCT Persid FROM Journal_personeel_verloning;"

Set rstMgr = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)


If rstMgr.EOF = False And rstMgr.BOF = False Then
      rstMgr.MoveFirst
      Do While rstMgr.EOF = False

            strMgr = DLookup("CHAUFFEURR", "Journal_personeel_verloning", _
                  "Persid = " & rstMgr!Persid.value)
            strSQL = "SELECT * FROM Journal_personeel_verloning WHERE " & _
                  "Persid = " & rstMgr!Persid.value & ";"


            Set qdf = dbs.QueryDefs(strTemp)
            qdf.Name = strMgr
            strTemp = qdf.Name
            qdf.SQL = strSQL
            qdf.Close
            Set qdf = Nothing


            DoCmd.TransferSpreadsheet _
            Transfertype:=acExport, _
            SpreadsheetType:=acSpreadsheetTypeExcel9, _
            TableName:=strTemp, _
            Filename:="M:\Public\Exports XLS\Personeel\" & strFileName & ".xls", _
            HasFieldNames:=True, _
            Range:=strMgr

            rstMgr.MoveNext


      Loop


End If


rstMgr.Close
Set rstMgr = Nothing
dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing

所以任何帮助都是非常感谢的

编辑：
让我更清楚一点：

Table 1:

ID Persid Chauffeur Proj Starttime Endtime
1  85     John      A    10:00     12:00
2  86     Fred      X    10:00     12:00
3  85     John      A    10:00     12:00
4  86     Fred      A    10:00     12:00

Journal_personeel_verloning_2_all (or table2)

Table 2:
ID Persid Chauffeur Proj Totalworkedtime(decimal)
1  85     John      A    4
2  86     Fred      A    2
3  86     Fred      X    2

Export must look like this:

1 excel file with:
tabname: John

ID Persid Chauffeur Proj Starttime Endtime
1  85     John      A    10:00     12:00
3  85     John      A    10:00     12:00

(1 or 2 empty rows)

ID Persid Chauffeur Proj Totalworkedtime(decimal)
1  85     John      A    4

same excel with second tabname: Fred

ID Persid Chauffeur Proj Starttime Endtime
2  86     Fred      X    10:00     12:00
4  86     Fred      A    10:00     12:00

(1 or 2 empty rows)

ID Persid Chauffeur Proj Totalworkedtime(decimal)
2  86     Fred      A    2
3  86     Fred      X    2

提前谢谢你
哈坎你好。请遵循并提供。从问题来看，不清楚在发布到stackoverflow之前您寻找了什么，为什么您认为提供的代码应该工作，以及是什么阻止了您的进步。您可能已经回答了自己的问题：表1和表2始终有完全相同的员工。因此，当然，每次运行代码都会覆盖相同的命名选项卡。为什么不合并两个表，然后在每个选项卡中导出？因为您已经知道如何使用记录集，而不是
TransferSpreadsheet
，请使用
Range.CopyFromRecordSet
。你将得到全额赔偿control@patrickHonorez谢谢你的帮助。我把上面几个示例中的代码放在一个工作代码中。所以我不是超级vba程序员，所以如果你能更具体地举例说明，那么我可以根据我的情况尝试实现。我曾经为此写过一个小函数。你可能会从中得到一些灵感。