Sometimes I need to create a SQL UNION query, but maintaining the union query over time can be painful.  Each unioned table/query must have the same number of fields (and names) in the same order. If some fields exist in one table and nt the other, a placeholder needs to be created in SQL with a NULL.  Over time, a field name is changed, the query fails and your are forced to wade through a very long SQL statement (A big hassle).

I used ChatGPT to create a Sub with params for two source tables (or queries) and the name of a union query that you want to create.  This way, anytime you want to change the fields in the sources, you can call this Sub to regenerate a working union query.

Usage:
             CreateUnionQuery "tableName", "queryName", "Q_new_union"

It works great. Enjoy!

Details

Public Sub CreateUnionQuery(sourceName1 As String, sourceName2 As String, outputQueryName As String)
    On Error GoTo ErrorHandler
  
    Dim db As Database
    Dim qdf As QueryDef
    Dim rst1 As Recordset
    Dim rst2 As Recordset
    Dim fields1 As Collection
    Dim fields2 As Collection
    Dim unionFields As Collection
    Dim fieldName As Variant
    Dim unionSQL As String
    Dim i As Integer
    Dim sqlPart1 As String
    Dim sqlPart2 As String
  
    Set db = CurrentDb
    Set fields1 = New Collection
    Set fields2 = New Collection
    Set unionFields = New Collection
  
    ' Check if sourceName1 exists
    If ObjectExists("Table", sourceName1) Or ObjectExists("Query", sourceName1) Then
        ' Get the fields from sourceName1
        Set rst1 = db.OpenRecordset(sourceName1)
        For i = 0 To rst1.Fields.Count - 1
            fields1.Add rst1.Fields(i).Name
        Next i
    Else
        MsgBox "Source " & sourceName1 & " does not exist.", vbExclamation
        Exit Sub
    End If
  
    ' Check if sourceName2 exists
    If ObjectExists("Table", sourceName2) Or ObjectExists("Query", sourceName2) Then
        ' Get the fields from sourceName2
        Set rst2 = db.OpenRecordset(sourceName2)
        For i = 0 To rst2.Fields.Count - 1
            fields2.Add rst2.Fields(i).Name
        Next i
    Else
        MsgBox "Source " & sourceName2 & " does not exist.", vbExclamation
        Exit Sub
    End If
  
    ' Create a collection of all unique field names
    For Each fieldName In fields1
        On Error Resume Next
        unionFields.Add fieldName, CStr(fieldName)
        On Error GoTo 0
    Next fieldName
  
    For Each fieldName In fields2
        On Error Resume Next
        unionFields.Add fieldName, CStr(fieldName)
        On Error GoTo 0
    Next fieldName
  
    ' Build the SQL for the UNION query with table aliases
    unionSQL = "SELECT "
  
    For Each fieldName In unionFields
        sqlPart1 = sqlPart1 & GetFieldSQL(fields1, rst1, CStr(fieldName), "S1") & ", "
        sqlPart2 = sqlPart2 & GetFieldSQL(fields2, rst2, CStr(fieldName), "S2") & ", "
    Next fieldName
  
    ' Remove the last comma and space from the SQL parts
    sqlPart1 = Left(sqlPart1, Len(sqlPart1) - 2)
    sqlPart2 = Left(sqlPart2, Len(sqlPart2) - 2)
  
    ' Combine the parts into the final UNION SQL
    unionSQL = unionSQL & sqlPart1 & " FROM [" & sourceName1 & "] AS S1 " & _
                          "UNION ALL SELECT " & sqlPart2 & " FROM [" & sourceName2 & "] AS S2;"
  
    ' Create or replace the output query
    If ObjectExists("Query", outputQueryName) Then
        Set qdf = db.QueryDefs(outputQueryName)
        qdf.SQL = unionSQL
    Else
        Set qdf = db.CreateQueryDef(outputQueryName, unionSQL)
    End If
  
    MsgBox "Union query '" & outputQueryName & "' created successfully.", vbInformation
    Exit Sub
  
ErrorHandler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
  
End Sub

Private Function ObjectExists(objType As String, objName As String) As Boolean
    Dim obj As Object
    On Error Resume Next
    Select Case objType
        Case "Table"
            Set obj = CurrentDb.TableDefs(objName)
        Case "Query"
            Set obj = CurrentDb.QueryDefs(objName)
    End Select
    ObjectExists = (Err.Number = 0)
    Set obj = Nothing
    On Error GoTo 0
End Function

Private Function IsAutoNumberField(rst As Recordset, fieldName As String) As Boolean
    Dim fld As Field
    Set fld = rst.Fields(fieldName)
    If fld.Type = dbLong Then
        IsAutoNumberField = fld.Attributes And dbAutoIncrField
    Else
        IsAutoNumberField = False
    End If
End Function

Private Function GetFieldSQL(fields As Collection, rst As Recordset, fieldName As String, aliasName As String) As String
    Dim sqlPart As String
    If IsInCollection(fields, fieldName) Then
        If IsAutoNumberField(rst, fieldName) Then
            sqlPart = "CLng(" & aliasName & ".[" & fieldName & "]) AS [" & fieldName & "]"
        Else
            sqlPart = aliasName & ".[" & fieldName & "] AS [" & fieldName & "]"
        End If
    Else
        sqlPart = "NULL AS [" & fieldName & "]"
    End If
    GetFieldSQL = sqlPart
End Function

Private Function IsInCollection(col As Collection, item As String) As Boolean
    Dim var As Variant
    IsInCollection = False
    For Each var In col
        If var = item Then
            IsInCollection = True
           Exit Function
        End If
    Next var
End Function