No clue why CopyFromRecordset wouldn't dump the data for these 2 systems but with the help from @frankball, copying the data into a variant, then looping through each value in the variant and writing it to a cell got it to work. Since I'm writing the field names in the first row, need to skip down to second row when writing the array. Final code:

Public Sub SendRecordsettoExcel(Rs As DAO.Recordset)
Dim intMaxCol As Integer
Dim intMaxRow As Integer

Dim objXL As Object
Dim objWkb As Object
Dim objSht As Object
Dim vaTmp() As String
Dim x, y As Long
Dim records As Variant
Dim FineColumnLetter As String
Dim BirthYearColumnLetter As String

On Error GoTo ErrorHandler

    If Not Rs.EOF Or Not Rs.BOF Then

        intMaxCol = Rs.Fields.Count
        If Rs.recordCount > 0 Then
          Rs.MoveLast
          Rs.MoveFirst
          intMaxRow = Rs.recordCount + 1
          Set objXL = CreateObject("Excel.Application")
          With objXL
            '.Visible = True
            Set objWkb = .Workbooks.Add
            Set objSht = objWkb.Worksheets(1)

            ' get the column headers
            ReDim vaTmp(Rs.Fields.Count)
            For x = 0 To Rs.Fields.Count - 1
                vaTmp(x) = Rs.Fields(x).Name
                If (Rs.Fields(x).Name = "Fine") Then
                    FineColumnLetter = Chr(x + 65)
                End If
                If (Rs.Fields(x).Name = "BirthYear") Then
                    BirthYearColumnLetter = Chr(x + 65)
                End If
            Next
            objSht.cells(1, 1).Resize(1, Rs.Fields.Count) = vaTmp

            Rs.MoveFirst
            records = Rs.GetRows(intMaxRow)
            For x = 0 To Rs.recordCount - 1
                For y = 0 To Rs.Fields.Count - 1
                    objSht.cells(x + 2, y + 1).Value = records(y, x)
                Next
            Next
          End With
        End If
    End If

ErrorHandler:

    Set objWkb = Nothing
    Set objSht = Nothing
    Set objXL = Nothing
End Sub