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

问题描述 投票：0回答：3

我正在尝试在VBA for Access 2010中编写循环，其中循环查看表（表：“SunstarAccountsInWebir_SarahTest”）并评估许多条件，并根据条件 - 然后可以循环通过另一个表（“ 1042s_FinalOutput_7“）以查看它是否具有匹配的ID。如果它匹配，则将“Test”插入到字段中，否则 - 它应该将该行值（从第一个循环 - 从“SunstarAccountsInWebir_SarahTest”中）导出到excel文件中。

我的问题是我的代码导出整个表“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

结束子

access-vba ms-access-2010
3个回答
0
投票

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

以下是根据您的开头段落了解您的目标的方法：

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

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

首先，正如@ScottHoltzman所提到的那样，你的代码中的DoCmd.TransferSpreadsheet语句当然会将整个表格转移到Excel，因为这就是你告诉它要做的事情。第3个参数指定要导出的数据，并为其提供了完整的表名，因此将导出完整的表。

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

  1. 评估qs中的记录。如果不符合标准，请转到下一个qs记录并重复步骤1。
  2. 如果qs中的记录符合标准，则在ss中根据此记录评估qs中的记录。
  3. 如果它们匹配，更新ss并移动到下一个ss记录，转到步骤2，记住qs仍然指向同一记录并且没有移动。
  4. 如果它们不匹配，将整个表格转移到Excel，现在移动到下一个ss记录，转到步骤2，再次记住qs仍然指向同一记录并且没有移动。
  5. 一旦ss中的所有记录都通过步骤2,3和4处理完毕，请转到下一个qs记录并转到步骤1

我希望你的代码可以反复多次将表导出到Excel。

我还希望您的代码在您开始处理继续执行到第2步的第二个qs记录时会出现错误，因为在处理完第一个满足您条件的qs记录的第2,3和4步后，ss RecordSet将指向EOF，并且您没有任何代码将指针移回ss中的第一条记录。

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

以下是一些应该以有效的方式实现此目标的代码。此代码尝试使用原始源中的表和条件。它还用更有用的With循环替换你的For块和Do循环，利用内置的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

我希望这有助于您更好地实现目标。

1
投票

这最终成为最接近的。我需要切换到“Do While”循环而不是第二个整数循环。代码如下：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
0
投票

创建一个这样的查询，然后执行它，然后返回dim rst作为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

然后输出rst - （取自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
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.