Ms access Access VBA将一行表格导出到excel电子表格，而不是整个表格

我正试图在VBA for Access 2010中编写一个循环，其中循环查看一个表：SunstarAccountsInWebir\u SarahTest并评估一系列条件，然后根据条件-可能会在另一个表1042s\u FinalOutput\u 7中循环，以查看它是否具有匹配的ID。如果匹配，它会将测试插入到一个字段中，如果不匹配，它应该将第一个循环中的值行导出到excel文件中

我的问题是，我的代码正在导出SunstarAccountsInWebir\u SarahTest表的全部内容，我只希望它导出与循环中I的值对应的行。我如何修改我的代码来做到这一点

Public Sub EditFinalOutput2()

'set loop variables
Dim i As Long
Dim qs As DAO.Recordset
Dim ss As DAO.Recordset
Dim strSQL As String
Dim external_nmad_id As String
Dim IRSfileFormatKey As String
'Function GetID(external_nmad_id As String, IRSfileFormatKey As String)

'open reference set
Set db = CurrentDb
Set qs = db.OpenRecordset("SunstarAccountsInWebir_SarahTest")
Set ss = db.OpenRecordset("1042s_FinalOutput_7")

'set loop for whole recordset(this is the original location, will try putting it within the If, ElseIf loop)
'For i = 0 To qs.RecordCount - 1

    With qs.Fields
    For i = 0 To qs.RecordCount - 1

        If (IsNull(!nmad_address_1) Or (!nmad_address_1 = !nmad_city) Or (!nmad_address_1 = !Webir_Country) And IsNull(!nmad_address_2) Or (!nmad_address_2 = !nmad_city) Or (!nmad_address_2 = !Webir_Country) And IsNull(!nmad_address_3) Or (!nmad_address_3 = !nmad_city) Or (!nmad_address_3 = !Webir_Country)) Then
        MsgBox "This was an invalid address"

        Else:
        With ss.Fields
                For j = 0 To ss.RecordCount - 1

                If (qs.Fields("external_nmad_id") = Right(ss.Fields("IRSfileFormatKey"), 10)) Then
                        ss.Edit
                        ss.Fields("box13_Address") = "Test"
                        ss.Update

                Else: DoCmd.TransferSpreadsheet acExport, 10, "SunstarAccountsInWebir_SarahTest", "\\DTCHYB-MNMH001\C_WBGCTS_Users\U658984\My Documents\pre processor\PreProcessor7\ToBeReviewed\AddressesNotActiveThisYear.xlsx", False

                End If

                ss.MoveNext
                Next j

                End With

        End If

    qs.MoveNext
    Next i

End With

'close reference set
qs.Close
Set qs = Nothing
ss.Close
Set ss = Nothing

---

End Sub

创建一个这样的查询，并执行它，然后将dim rst作为记录集返回 注意：我已将AND-s更改为OR-s，因为我认为这是您想要的

Select qs.*

From
    (Select *
     From SunstarAccountsInWebir_SarahTest
     Where Not
     (
        (IsNull(nmad_address_1) 
     Or (nmad_address_1 = nmad_city) 
     Or (nmad_address_1 = Webir_Country)

     OR IsNull(nmad_address_2) 
     Or (nmad_address_2 = nmad_city) 
     Or (nmad_address_2 = Webir_Country) 

     OR IsNull(nmad_address_3) 
     Or (nmad_address_3 = nmad_city) 
     Or (nmad_address_3 = Webir_Country)
     )
    ) as qs

Left Join
    (Select *
        ,Right(ss.Fields("IRSfileFormatKey"), 10) as ssKey
     From 1042s_FinalOutput_7
    ) as ss

On qs.external_nmad_id = ss.ssKey
Where ssKey is NULL

然后输出从中获取的rst

---

好的，根据你的目标，你的方法有一些错误

以下是我如何根据你的开场白理解你的目标：

循环表A中的每条记录。如果记录符合 在某些复杂条件下，搜索第二个表TableB以查看是否有 表B中的记录包含中此记录的匹配ID值 表A。如果存在匹配项，则更新TableB中的字段，否则，将记录从TableA导出到Excel

我将描述您所展示的代码是如何处理您的数据的，然后我将解释如何处理这个问题

首先，正如@ScottHoltzman所暗示的，代码中的DoCmd.TransferSpreadsheet语句当然会将整个表传输到Excel，因为这是您告诉它的。第三个参数指定要导出的数据，您为其指定了完整的表名，因此将导出完整的表

其次，我认为您误解了代码中两个记录集的循环是如何实际运行的。您的代码正在执行以下操作：

评估qs中的记录。如果不符合标准，请转到下一个qs记录并重复步骤1。 如果qs中的记录确实符合标准，则根据qs中的记录评估ss中的记录。 如果它们匹配，更新ss并移动到下一个ss记录，请转至步骤2，记住qs仍指向同一记录且未移动。 如果它们不匹配，将整个表转移到Excel，现在移动到下一个ss记录，转到步骤2，再次记住qs仍然指向同一记录，并且没有移动。 通过步骤2、3和4处理完ss中的所有记录后，转到下一个qs记录并转到步骤1 我希望您的代码多次将表导出到Excel

我还希望您的代码在您开始处理第二个qs记录（移动到步骤2）时会出现错误，因为在为满足您的条件的第一个qs记录处理步骤2、3和4之后，ss记录集将指向EOF，并且您没有任何代码将指针移回ss中的第一个记录

无论如何，因为您有一个复杂的标准来确定是否导出记录，所以我建议在TableA中添加一个名为ToExport的True/False字段。现在，在代码的开头，您将表A中的所有记录设置为export=False。然后，您的代码将计算TableA中的每个记录，以确定是否应导出该记录。如果应该，则更新ToExport为True。循环遍历整个表后，只有需要导出的记录才会标记为ToExport=True。现在，您只需将真实记录导出到Excel，从而获得所需的结果

下面是一些应该以有效的方式实现这一目标的代码。此代码尝试使用原始源代码中的表和条件。它还利用内置的记录集循环和EOF检查，用块替换您的，用更有用的Do循环替换For循环

Public Sub EditFinalOutput2()
Dim db As DAO.Database
Dim qs As DAO.Recordset
Dim ss As DAO.Recordset
Dim strSQL As String

Set db = CurrentDb()
strSQL = "UPDATE [SunstarAccountsInWebir_SarahTest] SET ToExport = False;"
db.Execute strSQL
Set qs = db.OpenRecordset("SunstarAccountsInWebir_SarahTest", dbOpenDynaset)

Do While Not qs.EOF
    If (IsNull(qs("nmad_address_1")) Or (qs("nmad_address_1") = qs("nmad_city")) Or (qs("nmad_address_1") = qs("Webir_Country")) And IsNull(qs("nmad_address_2")) Or (qs("nmad_address_2") = qs("nmad_city")) Or (qs("nmad_address_2") = qs("Webir_Country")) And IsNull(qs("nmad_address_3")) Or (qs("nmad_address_3") = qs("nmad_city")) Or (qs("nmad_address_3") = qs("Webir_Country"))) Then
        MsgBox "This was an invalid address"
    Else
        strSQL = "SELECT * FROM [1042s_FinalOutput_7] WHERE Right([IRSfileFormatKey], 10) = """ & qs("external_nmad_id") & """;"
        Set ss = db.OpenRecordset(strSQL, dbOpenDynaset)
        If ss.BOF Then
            qs.Edit
            qs("ToExport") = True
            qs.Update
        Else
            Do While Not ss.EOF
                ss.Edit
                ss("box13_Address") = "Test"
                ss.Update
                ss.MoveNext
            Loop
        End If
        ss.Close
    End If
    qs.MoveNext
Loop
qs.Close
strSQL = "SELECT * FROM [SunstarAccountsInWebir_SarahTest] WHERE ToExport = True;"
DoCmd.TransferSpreadsheet acExport, 10, strSQL, "\\DTCHYB-MNMH001\C_WBGCTS_Users\U658984\My Documents\pre processor\PreProcessor7\ToBeReviewed\AddressesNotActiveThisYear.xlsx", False

Set qs = Nothing
Set ss = Nothing
db.Close
Set db = Nothing
End Sub

---

我希望这能帮助你更好地实现你的目标。

这是最接近的。我需要切换到Do While循环，而不是第二个整数循环。so的代码如下：Public Sub editFinalOut2

'set variables
Dim i As Long
Dim qs As DAO.Recordset
Dim ss As DAO.Recordset
Dim strSQL As String
Dim external_nmad_id As String
Dim IRSfileFormatKey As String
Dim mytestwrite As String
mytestwrite = "No"

'open reference set
Set db = CurrentDb
Set qs = db.OpenRecordset("SunstarAccountsInWebir_SarahTest")
Set ss = db.OpenRecordset("1042s_FinalOutput_7")

    With qs.Fields
    For i = 0 To qs.RecordCount - 1

        If (IsNull(!nmad_address_1) Or (!nmad_address_1 = !nmad_city) Or 
(!nmad_address_1 = !Webir_Country) And IsNull(!nmad_address_2) Or (!nmad_address_2 = 
!nmad_city) Or (!nmad_address_2 = !Webir_Country) And IsNull(!nmad_address_3) Or 
(!nmad_address_3 = !nmad_city) Or (!nmad_address_3 = !Webir_Country)) Then
        DoCmd.RunSQL "INSERT INTO Addresses_ToBeReviewed SELECT 
SunstarAccountsInWebir_SarahTest.* FROM SunstarAccountsInWebir_SarahTest WHERE 
(((SunstarAccountsInWebir_SarahTest.external_nmad_id)='" & qs!external_nmad_id & 
"'));"

        Else:

        Set ss = db.OpenRecordset("1042s_FinalOutput_7")
        With ss.Fields

            'if not invalid address, loop through second (final output) table to find 
matching ID's
                If ss.EOF = False Then

                ss.MoveFirst
                Do
                Dim mykey As String
                mykey = Right(ss!IRSfileFormatKey, 10)
                Debug.Print mykey
                If qs.Fields("external_nmad_id") = mykey Then
                    ss.Edit
                    ss.Fields("box13c_Address") = qs.Fields("nmad_address_1") & 
qs.Fields("nmad_address_2") & qs.Fields("nmad_address_3")
                    ss.Update
                    mytestwrite = "Yes"

                End If

                ss.MoveNext

            'if the valid address doesn't match to final output table, add to list of 
addresses not matched
                Loop Until ss.EOF
                If mytestwrite = "No" Then
                    DoCmd.SetWarnings False
                    DoCmd.RunSQL "INSERT INTO Addresses_NotUsed SELECT 
SunstarAccountsInWebir_SarahTest.* FROM SunstarAccountsInWebir_SarahTest WHERE 
(((SunstarAccountsInWebir_SarahTest.external_nmad_id)='" & qs!external_nmad_id & 
"'));"
                    DoCmd.SetWarnings True

                End If
            End If
        End With

        End If

    qs.MoveNext
    Next i

End With

'close reference set
qs.Close
Set qs = Nothing
ss.Close
Set ss = Nothing

End Sub

---

代替SunstarAccountsInWebir\u SarahTest上的DoCmd.TransferSpreadsheet，编写一个查询，该查询采用一个参数，该参数根据i是什么过滤该表并导出查询结果。它可能会采取一些措施使其正常工作。您能否详细说明它将如何输出？在步骤中，如果qs.fieldsTernal\u nmad\u id。。。当我跨过它时-当我将光标悬停时，会显示正确的ID。所以我可以使用其他类似的东西：qs.Fields。。。对。字段。。。；但我不知道接下来该说什么。我一直在尝试在VBA中声明和创建查询，但要选择的实际查询将非常长，这就是为什么我将其作为

---

loopHello@rgorowsky，运气好吗？这两种解决方案中的任何一种都有助于解决您的问题吗？如果您仍然有问题，请发布更新。如果您的问题已得到解决，请更新解决方案，以便帮助其他人，或者请接受其中一个提供的答案和/或投票，以帮助其他人了解解决您问题的原因。谢谢，这是最接近的。我需要切换到Do While循环，而不是第二个整数循环。so的代码如下：对不起，点击了检查，什么也没发生-仍在学习礼仪。谢谢你的帮助！

'set variables
Dim i As Long
Dim qs As DAO.Recordset
Dim ss As DAO.Recordset
Dim strSQL As String
Dim external_nmad_id As String
Dim IRSfileFormatKey As String
Dim mytestwrite As String
mytestwrite = "No"

'open reference set
Set db = CurrentDb
Set qs = db.OpenRecordset("SunstarAccountsInWebir_SarahTest")
Set ss = db.OpenRecordset("1042s_FinalOutput_7")

    With qs.Fields
    For i = 0 To qs.RecordCount - 1

        If (IsNull(!nmad_address_1) Or (!nmad_address_1 = !nmad_city) Or 
(!nmad_address_1 = !Webir_Country) And IsNull(!nmad_address_2) Or (!nmad_address_2 = 
!nmad_city) Or (!nmad_address_2 = !Webir_Country) And IsNull(!nmad_address_3) Or 
(!nmad_address_3 = !nmad_city) Or (!nmad_address_3 = !Webir_Country)) Then
        DoCmd.RunSQL "INSERT INTO Addresses_ToBeReviewed SELECT 
SunstarAccountsInWebir_SarahTest.* FROM SunstarAccountsInWebir_SarahTest WHERE 
(((SunstarAccountsInWebir_SarahTest.external_nmad_id)='" & qs!external_nmad_id & 
"'));"

        Else:

        Set ss = db.OpenRecordset("1042s_FinalOutput_7")
        With ss.Fields

            'if not invalid address, loop through second (final output) table to find 
matching ID's
                If ss.EOF = False Then

                ss.MoveFirst
                Do
                Dim mykey As String
                mykey = Right(ss!IRSfileFormatKey, 10)
                Debug.Print mykey
                If qs.Fields("external_nmad_id") = mykey Then
                    ss.Edit
                    ss.Fields("box13c_Address") = qs.Fields("nmad_address_1") & 
qs.Fields("nmad_address_2") & qs.Fields("nmad_address_3")
                    ss.Update
                    mytestwrite = "Yes"

                End If

                ss.MoveNext

            'if the valid address doesn't match to final output table, add to list of 
addresses not matched
                Loop Until ss.EOF
                If mytestwrite = "No" Then
                    DoCmd.SetWarnings False
                    DoCmd.RunSQL "INSERT INTO Addresses_NotUsed SELECT 
SunstarAccountsInWebir_SarahTest.* FROM SunstarAccountsInWebir_SarahTest WHERE 
(((SunstarAccountsInWebir_SarahTest.external_nmad_id)='" & qs!external_nmad_id & 
"'));"
                    DoCmd.SetWarnings True

                End If
            End If
        End With

        End If

    qs.MoveNext
    Next i

End With

'close reference set
qs.Close
Set qs = Nothing
ss.Close
Set ss = Nothing

End Sub