如何将几乎所有字段值复制到 Access VBA 中的重复行中？

Question

我有一个程序用逗号分隔 Lines Of Business 字段，然后获取这些分隔值并将它们分布在原始行的重复行上，在名为 lob 的列中。主键是自动生成的 ID.

这里是所需行为的简明示例（为了视觉清晰省略了许多字段）：

在运行模块之前：

 +--------------------------------------------+
 |  ID   | App Code  |   Lines Of Business    |
 +-------+-----------+------------------------+
 |   1   |    AB23   | Value1, Value 2,Value3 |
 +------ +-----------+------------------------+
 |   2   |    XY45   |         Value 2        |
 +--------------------------------------------+

在运行模块之后：

 +-------------------------------------------------------+
 |  ID   | App Code  |   Lines Of Business    |   lob    |
 +-------+-----------+------------------------+----------+
 |   1   |    AB23   | Value1, Value 2,Value3 |  Value1  |
 +-------+-----------+------------------------+----------+
 |   2   |    XY45   |         Value 2        |  Value 2 |
 +-------+-----------+------------------------+----------+ 
 |   3   |    AB23   | Value1, Value 2,Value3 |  Value 2 |
 +-------+-----------+------------------------+----------+
 |   4   |    AB23   | Value1, Value 2,Value3 |  Value3  |
 +-------------------------------------------------------+

您将在下面的代码中看到几个类似的语句，包括：

strSOC1 = ![SOC 1] & ""
strL3 = ![L3] & ""
strAppCode = ![App Code] & ""

和

![Current Lifecycle Phase] = strCurrentLifecyclePhase
![SOC 1] = strSOC1
![L3] = strL3

我想做的是简化它，而不是为需要复制到新的重复行的每个字段创建一个变量（即 [=43= 中的 App Code 字段]），所有字段（除了 lob 由逗号分隔生成）被立即复制。

我还有许多其他字段需要复制过来，因此使用我当前的方法完成此操作将导致我创建一长串变量（或字典）并且代码不会是 portable 到其他 table。

那么，我怎样才能做到这一点？

这是我的代码，因为我是 VBA 的新手，所以它得到了其他 SO 用户的很多帮助。

Option Explicit

Public Sub ReformatTable()

    Dim db                       As DAO.Database
    Dim rs                       As DAO.Recordset
    Dim rsADD                    As DAO.Recordset

    Dim strSQL                   As String
    Dim strLinesOfBusiness       As String
    Dim strSOC1                  As String
    Dim strCurrentLifecyclePhase As String
    Dim strL3                    As String
    Dim strL4                    As String
    Dim strlob                   As String
    Dim strAppCode               As String
    Dim varData                  As Variant
    Dim i                        As Integer

    Set db = CurrentDb

    ' Add a field into the existing IIPM table called lob.
    ' Values created during the Line Of Business split will be stored here.
    Dim strDdl As String
    strDdl = "ALTER TABLE IIPM ADD COLUMN lob TEXT(255);"
    CurrentProject.Connection.Execute strDdl

    ' Select all fields that have a Line of Business and are unprocessed (lob is Null)
    strSQL = "SELECT *, lob FROM IIPM WHERE ([Lines Of Business] Is Not Null) AND ([lob] Is Null)"

    Set rsADD = db.OpenRecordset("IIPM", dbOpenDynaset, dbAppendOnly)

    Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)

    With rs
        While Not .EOF
            strLinesOfBusiness = ![Lines Of Business] & "" ' Append empty string to mitigate error when cell in field is null
            strCurrentLifecyclePhase = ![Current Lifecycle Phase] & ""
            strSOC1 = ![SOC 1] & ""
            strL3 = ![L3] & ""
            strAppCode = ![App Code] & ""
            varData = Split(strLinesOfBusiness, ",") ' Get all comma delimited fields

            ' Update First Record
            .Edit
            !lob = Trim(varData(0)) ' remove spaces before writing new fields
            ![App Code] = strAppCode
            .Update

            ' Add records with same first field
            ' and new fields for remaining data at end of string
            For i = 1 To UBound(varData)
                With rsADD
                    .AddNew
                    ![Lines Of Business] = strLinesOfBusiness
                    ![Current Lifecycle Phase] = strCurrentLifecyclePhase
                    ![SOC 1] = strSOC1
                    ![L3] = strL3
                    ![L4] = strL4
                    !lob = Trim(varData(i)) ' remove spaces before writing new fields
                    ![App Code] = strAppCode
                    .Update
                End With
            Next
            .MoveNext
        Wend

        .Close
        rsADD.Close

    End With

    Set rsADD = Nothing
    Set rs = Nothing

    ' Remove empty rows which only contain an ID.
    CurrentProject.Connection.Execute "DELETE FROM IIPM WHERE lob IS NULL AND [App Code] IS NULL AND [Lines Of Business] IS NULL;"

    db.Close
    Set db = Nothing

End Sub

Answer 1

首先，我找到了所有这些

strL3 = ![L3] & ""

和

![L3] = strL3

有问题 - 您正在将 NULL 值转换为空字符串，没有理由这样做。

其次，要对所有字段执行此操作，您可以循环 Recordset.Fields 集合。

删除所有 str<Fieldname> 变量，然后执行此操作：

Dim fld As DAO.Field

' ...

Set rsADD = db.OpenRecordset("IIPM", dbOpenDynaset, dbAppendOnly)

Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)

With rs
    While Not .EOF
        varData = Split(rs![Lines Of Business], ",") ' Get all comma delimited fields

        ' Update First Record
        .Edit
        !lob = Trim(varData(0)) ' remove spaces before writing new fields
        ' ![App Code] = strAppCode  ' unnecessary
        .Update

        ' Add records with same first field
        ' and new fields for remaining data at end of string

        For i = 1 To UBound(varData)
            rsADD.AddNew
            For Each fld In rsADD.Fields
                If fld.Name <> "lob" And fld.Name <> "ID" Then
                    ' Copy all fields except "lob" and "ID"
                    rsADD(fld.Name) = rs(fld.Name)
                End If
            Next fld
            ' lob is set separately, ID is set automatically
            rsADD!lob = Trim(varData(i))   ' remove spaces before writing new fields
            rsADD.Update
        Next i

        .MoveNext
    Wend

    .Close
    rsADD.Close

End With

Set rsADD = Nothing
Set rs = Nothing

注意：嵌套的 With 块是有问题的，所以我一直使用记录集名称。

如何将几乎所有字段值复制到 Access VBA 中的重复行中？

How can I copy almost all field values into a duplicated row in Access VBA?

ms-access

vba

ms-access-2010