Wie kann ich fast alle Feldwerte in eine doppelte Zeile in Access VBA kopieren?

Question

Ich habe ein Programm, das das Feld Lines Of Business auf Kommas aufteilt, dann diese aufgeteilten Werte übernimmt und sie über doppelte Zeilen der ursprünglichen Zeile in einer Spalte mit der Bezeichnung lob verteilt. Der Primärschlüssel ist ein automatisch generiertes ID.

Hier ist ein prägnantes Beispiel für erwünschtes Verhalten (viele Felder für visuelle Klarheit weggelassen):

Vor der Ausführung Modul:

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

Nach Modul ausgeführt wird:

+-------------------------------------------------------+ 
| 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 | 
+-------------------------------------------------------+ 

Sie werden mehrere ähnliche Anweisungen im Code siehe unten, einschließlich:

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

und

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

Was würde Ich mag es, dies zu tun zu vereinfachen, so dass stattdessen eine Variable zu schaffen für jedes Feld, das muss in die neue doppelte Zeile kopiert werden (d. h das Feld App Code in der obigen Tabelle), werden alle Felder (außer lob, die durch die Trennung von Kommata generiert werden) sofort kopiert.

Ich habe Dutzende von anderen Feldern, die kopiert werden müssen, so würde dies mit meiner aktuellen Methode würde ich eine lange Liste von Variablen (oder ein Wörterbuch) erstellen und der Code wäre nicht auf andere Tabellen übertragbar .

Also, wie könnte ich das erreichen?

Hier ist mein Code, der viel Hilfe von anderen SO-Benutzern hatte, da ich ziemlich neu in VBA bin.

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

Zuerst finde ich alle diese

strL3 = ![L3] & "" 

und

![L3] = strL3 

problematisch - Sie NULL-Werte konvertieren Zeichenfolgen zu leeren, gibt es keinen Grund, das zu tun.

Zweitens, um dies für alle Felder zu tun, können Sie die Recordset.Fields Sammlung loopen.

Sie sich von allen str<Fieldname> Variablen zu befreien, und dies tun:

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 

Hinweis: verschachtelte With Blöcke problematisch sind, so habe ich immer die Cord-Namen verwendet.