Tilføje X nye kolonner

Jeg bruger følgende kode til at optælle en variabel der bestemer hvor mange nye kolonner der skal tilføjes tabellen:
  Dim DB As New ADODB.Connection
  Dim RecSet As New ADODB.Recordset
  Set DB = CurrentProject.Connection
  Set tdf = DB
  RecSet.Open "vejmanperson19982002", DB, adOpenKeyset, adLockOptimistic, adCmdTable
  max_pers = 1
  Do While (RecSet.EOF = False)
    antal_pers = RecSet("personnr")
    If antal_pers > max_pers Then
      max_pers = antal_pers
    End If
    RecSet.MoveNext
  Loop

Og får derefter en værdi i variablen max_pers.

Når så jeg vil tilføje antallet af kolonner til tabellen med følgende kode:
i = 2
Do While i <= max_pers
    DB.Execute "Alter table vejmanperson19982002 add Elem_nr" & i &" Integer"
Loop

Melder den følgende fejl:
Databasemotoren kan ikke låse tabellen vejmanperson19982002 fordi den allerede anvendes af en anden person eller process.

Hvad er det jeg gør forkert?

På forhånd tak.