Run-time error '1004' while populating over 256 excel columns (1 Viewer)

Option Compare Database
Option Explicit

Dim xlApp As Excel.Application
Dim xlWkb As Excel.Workbook
Dim xlWks As Excel.Worksheet
Dim FileNameOut As String
Dim RowNr As Long
Dim ColNr As Long

Dim rst As DAO.Recordset
Dim rstAdd As DAO.Recordset

Dim CurrentDIV_NR As String

Public Sub test()
  Call fn_Main_Export2Excel
End Sub

Public Function fn_Main_Export2Excel() As Boolean
  Call pr_Init
  Call pr_Headings
  rst.MoveFirst
  While Not rst.EOF
     Call VerwerkRecord
     rst.MoveNext
  Wend

  Call pr_Exit
End Function

Private Sub VerwerkRecord()
  Dim i As Long
  
  CurrentDIV_NR = rst.Fields(0)
  
  RowNr = RowNr + 1
  ColNr = 0
  
  For i = 0 To rst.Fields.Count - 1
    ColNr = ColNr + 1
    xlWks.Cells(RowNr, ColNr) = rst.Fields(i)
  Next i
  
  Call pr_Additional_Table
  
End Sub

Private Sub pr_Additional_Table()
  Dim SourceQuery2 As String
  Dim i As Long
  
  SourceQuery2 = "SELECT * FROM Tbl_PERSONS WHERE DIV_NR = " & Chr(34) & CurrentDIV_NR & Chr(34)
  'SourceQuery2 = "SELECT * FROM Tbl_PERSONS_SMALL WHERE DIV_NR = " & Chr(34) & CurrentDIV_NR & Chr(34)
  
  Set rstAdd = CurrentDb.OpenRecordset(SourceQuery2)
  
  If RowNr = 2 Then
    For i = 0 To rstAdd.Fields.Count - 1
      xlWks.Cells(1, ColNr + i + 1) = rstAdd.Fields(i).Name
    Next i
  End If
  
  rstAdd.MoveFirst
  For i = 0 To rstAdd.Fields.Count - 1
    ColNr = ColNr + 1
    xlWks.Cells(RowNr, ColNr) = rstAdd.Fields(i)
  Next i
  
  
  rstAdd.Close
  Set rstAdd = Nothing
End Sub

Private Sub pr_Headings()
  Dim i As Long
  
  RowNr = RowNr + 1

  For i = 0 To rst.Fields.Count - 1
    'rst.Fields(i).Type
    xlWks.Cells(RowNr, i + 1) = rst.Fields(i).Name
  Next i
End Sub

Private Sub pr_Init()
  Call pr_Init_Table
  Call pr_Init_Excel
  RowNr = 0
  ColNr = 0
End Sub

Private Sub pr_Exit()
  Call pr_Exit_Excel
  Call pr_Exit_Table
End Sub

Private Sub pr_Init_Table()
  Dim SourceQuery As String
  
  SourceQuery = "SELECT * FROM Tbl_PASS"
  
  Set rst = CurrentDb.OpenRecordset(SourceQuery)
End Sub

Private Sub pr_Init_Excel()
  Set xlApp = New Excel.Application
  xlApp.Visible = True
  Set xlWkb = Excel.Workbooks.Add
  Set xlWks = xlWkb.Sheets.Add

  'FileNameOut = Excel.Application.GetSaveAsFilename
  FileNameOut = ThisDbPath() & "Uitvoer.xlsx"
End Sub

Private Sub pr_Exit_Table()
  rst.Close
  Set rst = Nothing
End Sub

Private Sub pr_Exit_Excel()
  If Dir(FileNameOut) <> "" Then
    Kill FileNameOut
  End If
  
  xlApp.DisplayAlerts = False
  xlWkb.SaveAs FileNameOut
  xlApp.DisplayAlerts = True
  xlWkb.Close
  xlApp.Quit

  Set xlWkb = Nothing
  Set xlApp = Nothing
  Set xlWks = Nothing
End Sub

...
 
  If RowNr = 2 Then
    For i = 0 To rstAdd.Fields.Count - 1
      [COLOR=red]xlWks.Cells(1, ColNr + i + 1) = rstAdd.Fields(i).Name[/COLOR]
    Next i
  End If
 
...