访问 VBA 将 table 的一行导出到 excel 电子表格，而不是整个 table

Question

我正在尝试在 VBA 中为 Access 2010 编写一个循环，其中循环查看 table (table: "SunstarAccountsInWebir_SarahTest") 并计算一个条件的数量，并取决于条件 - 然后可能会循环遍历不同的 table ("1042s_FinalOutput_7") 以查看它是否具有匹配的 ID。如果它确实匹配，它会将 "Test" 插入到一个字段中，如果不匹配 - 它应该将该行值（从第一个循环 - 在 "SunstarAccountsInWebir_SarahTest" 之外）导出到 excel 文件中。

我的问题是我的代码正在导出整个 table "SunstarAccountsInWebir_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

结束子

Answer 1

像这样创建一个查询，并执行它，return dim rst as Recordset 注意：我已将 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

然后输出第一个——（取自https://support.microsoft.com/en-us/help/246335/how-to-transfer-data-from-an-ado-recordset-to-excel-with-automation）

' Copy field names to the first row of the worksheet
fldCount = rst.Fields.Count
For iCol = 1 To fldCount
    xlWs.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name
Next


' Copy the recordset to the worksheet, starting in cell A2
xlWs.Cells(2, 1).CopyFromRecordset rst
'Note: CopyFromRecordset will fail if the recordset
'contains an OLE object field or array data such
'as hierarchical recordsets

Answer 2

好的，根据您的既定目标，您的方法存在一些错误。

根据您的开头段落，我是这样理解您的目标的：

Loop through each record in table TableA. If the record meets certain complex criteria, search a second table TableB to see if any records in TableB contain a matching ID value from this record in TableA. If a match exists, update a field in TableB, otherwise, export the record from TableA to Excel.

我将描述您提供的代码如何处理您的数据，然后我将解释我将如何解决这个问题。

首先，正如@ScottHoltzman 所暗示的，您代码中的 DoCmd.TransferSpreadsheet 语句当然会将整个 table 转移到 Excel，因为这就是您所说的它去做。第三个参数指定要导出的数据，你给了它完整的table名称，所以将导出完整的table。

其次，我认为您误解了在代码中循环遍历两个 RecordSet 的实际运作方式。您的代码正在执行以下操作：

评估 qs 中的记录。如果不符合条件，则移至下一个 qs 记录并重复步骤 1。
如果 qs 中的记录确实符合条件，则根据 qs 中的记录评估 ss 中的记录。
如果匹配，更新ss并移动到下一条ss记录，转到第2步，记住qs仍然指向同一条记录，并没有移动.
如果不匹配，将整个table转移到Excel，现在移动到下一个ss记录，转到第2步，再次记住qs仍然指向同一条记录，没有移动。
在 ss 中的所有记录都通过步骤 2、3 和 4 处理后，移至下一个 qs 记录并转到步骤 1

我希望您的代码一遍又一遍地将 table 导出到 Excel。

我还希望您的代码在您开始处理第二条 qs 记录后立即出现错误，该记录将进入第 2 步，因为在处理完第一个 [ 的第 2、3 和 4 步之后=18=] 记录满足您的条件，ss RecordSet 将指向 EOF，并且您没有任何代码将指针移回 ss 中的第一条记录。

无论如何，由于您有一个复杂的标准来确定是否导出记录，我建议向 TableA 添加一个名为 ToExport 的 True/False 字段。现在，在代码的开头，您将为 TableA 中的所有记录设置 ToExport = False。然后，您的代码将评估 TableA 中的每条记录，以确定是否应导出该记录。如果应该，您将 ToExport 更新为 True。一旦你遍历了整个table，只有需要导出的记录会被标记为ToExport = True。现在，您只需将 True 条记录导出到 Excel，从而实现您想要的结果。

这里有一些代码可以有效地实现这个目标。此代码尝试使用原始来源中的 tables 和条件。它还用更有用的 Do 循环替换了 With 块和 For 循环，利用了内置的 RecordSet 循环和 EOF 检查。

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

希望本文能帮助您更好地实现目标。

Answer 3

这是最接近的。我需要切换到 "Do While" 循环而不是第二个整数循环。所以的代码是 below:Public Sub EditFinalOutput2()

'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

访问 VBA 将 table 的一行导出到 excel 电子表格，而不是整个 table

Access VBA export one row of table to excel spreadsheet, not entire table

ms-access

vba

ms-access-2010