GPT Paste

Sub AddTypDtyFieldsToAnotherTable()
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim srcTableName As String
    Dim destTableName As String
    Dim insertSQL As String

    ' Define the source and destination table names
    srcTableName = "YourSourceTableName" ' Replace with your source table name
    destTableName = "YourDestinationTableName" ' Replace with your destination table name

    ' Get a reference to the current database
    Set db = CurrentDb

    ' Ensure the destination table exists
    If Not TableExists(destTableName) Then
        MsgBox "Destination table '" & destTableName & "' does not exist.", vbExclamation
        Exit Sub
    End If

    ' Get the source table definition
    On Error Resume Next
    Set tdf = db.TableDefs(srcTableName)
    If Err.Number <> 0 Then
        MsgBox "Source table '" & srcTableName & "' does not exist.", vbExclamation
        Exit Sub
    End If
    On Error GoTo 0

    ' Loop through the fields in the source table
    For Each fld In tdf.Fields
        If Right(fld.Name, 7) = "_TypDty" Then
            ' Create SQL to insert the field name into the destination table
            insertSQL = "INSERT INTO " & destTableName & " (FieldNameColumn) VALUES ('" & fld.Name & "')"
            db.Execute insertSQL, dbFailOnError
        End If
    Next fld

    ' Clean up
    Set fld = Nothing
    Set tdf = Nothing
    Set db = Nothing

    MsgBox "Fields ending with '_TypDty' have been added to the destination table.", vbInformation
End Sub

' Helper function to check if a table exists
Function TableExists(tableName As String) As Boolean
    Dim tdf As DAO.TableDef
    On Error Resume Next
    Set tdf = CurrentDb.TableDefs(tableName)
    TableExists = Not tdf Is Nothing
    Set tdf = Nothing
    On Error GoTo 0
End Function