Access 2000 VB Code bleibt plötzlich hängen

Option Compare Database

Public Function Gastdaten_holen()

Dim PlNr, Stat As String 'Reservierungen  
Dim Anr, Abr As Date
Dim Kat, BuNr, Aufent As Long


'Reservierungen löschen  
With CurrentDb.OpenRecordset("Reservierungen")  
 While Not .EOF
  .MoveFirst
   .Delete
  .MoveNext
 Wend

Ich hoffe der Code ist nun nicht zu lang.
 .Close
End With

'Counter = 0  
'Reservierungen updaten  
With CurrentDb.OpenRecordset("Select Nr, Kategori, BAN, BAB, Status, BookingNr, KundLbNr from ssc_Bookings_byDay")  
 .MoveFirst
 While Not .EOF
   
   'Inc (Counter)  
   'Print "Akt Record " + Counter  
   
   PlNr = !NR
   Kat = !Kategori
   Anr = DateAdd("d", -2, Format(!BAN, "dd.mm.yyyy"))  'Format(!BAN, "dd.mm.yyyy")  
   Abr = DateAdd("d", -2, Format(!BAB, "dd.mm.yyyy"))  'Format(!BAB, "dd.mm.yyyy")  
   Aufent = DateDiff("d", Anr, Abr)  
   Stat = !Status
   GaNr = !KundLbNr
   BNu = !BookingNr
   HNR = 0
      With CurrentDb.OpenRecordset("Reservierungen")  
       .AddNew
        !PlatzNr = PlNr
        !Kategorie = Kat
        !BAN = Anr
        !BAB = Abr
        !Aufenthalt = Aufent
        !Status = Stat
        !GNR = GaNr
        !BNR = BNu
       .Update
       .Close
      End With
    BuNr = 0
  .MoveNext
 Wend
.Close
End With
'MsgBox "Reservierungen fertig"  
Call Mitglholen
Call Gastname_aktualisieren
With CurrentDb.OpenRecordset("HDatum")  
 .AddNew
 !Dholen = Date
 !Dtimeholen = Time()
 .Update
 .Close
End With
End Function


Public Function Mitglholen()

Dim VN, NM, HTxt, H2Txt, Sex, DText, HGNR As String 'Mitglieder  
Dim Anzahl, GNR, LNr As Long
Dim Gebu As Date

'Mitglieder löschen  
With CurrentDb.OpenRecordset("Mitglieder")  
 While Not .EOF
  .MoveFirst
   .Delete
  .MoveNext
 Wend
 .Close
End With
'Familienmitglieder  


 With CurrentDb.OpenRecordset("Select GNR, DATUM, NotatKey, LinNr, Tekst, Status From G_Anwesende_Mitglieder")  
 If Not .EOF Then
 .MoveFirst
  While Not .EOF
   If !NotatKey > 0 Then
     If !LinNr = 2 Then
         HTxt = Left(!Tekst, 2)
        If HTxt Like "m^*" Or HTxt Like "w^*" Or HTxt Like "G^*" Then  
         GNR = !NotatKey
         LNr = !LinNr
         VN = "K"  
         NN = "K"  
         Sex = Left(!Tekst, InStr(Trim(!Tekst), "^") - 1)  
         H2Txt = Mid(!Tekst, InStr(Trim(!Tekst), "^") + 1)  
         If Not H2Txt Like "" Or H2Txt Like "     *" Then  
          H2Txt = Mid(!Tekst, InStr(Trim(!Tekst), "^") + 1)  
         End If
         If Not H2Txt Like "   *" Or H2Txt Like "" Then  
           H2Txt = Left(H2Txt, InStr(H2Txt, "^") - 1)  
         End If
         If IsDate(H2Txt) = True Then DText = Format(H2Txt, "dd.mm.yyyy")  
         If IsDate(H2Txt) = False Then DText = "01.01.1910"  
         Anzahl = 1
        Else
         If HTxt Like "^*" Then  
          GNR = !NotatKey
          LNr = !LinNr
          VN = "K"  
          NN = "K"  
          Sex = "o"  
          Gebu = "01.10.1910"  
          Anzahl = 1
         End If
        End If
     Else
       If !LinNr > 2 Then
         GNR = !NotatKey
         LNr = !LinNr
         H2Txt = Mid(!Tekst, InStr(Trim(!Tekst), "^") + 1)  
         VN = Left(!Tekst, InStr(Trim(!Tekst), "^") - 1)  
         If H2Txt Like "" Or H2Txt Like "     *" Then  
          NN = "K"  
         Else
          NN = Left(H2Txt, InStr(H2Txt, "^") - 1)  
         End If
         H2Txt = Mid(H2Txt, InStr(H2Txt, "^") + 1)  
         If H2Txt Like "m^*" Or HTxt Like "w^*" Or HTxt Like "G^*" Then  
          Sex = Left(H2Txt, InStr(H2Txt, "^") - 1)  
         Else
          Sex = "o"  
         End If
         If Not H2Txt Like "" Or H2Txt Like "     *..." Then  
          H2Txt = Mid(H2Txt, InStr(H2Txt, "^") + 1)  
          H3Txt = Mid(H2Txt, InStr(H2Txt, "^") + 1)  
          If H2Txt Like "" Or H2Txt Like "     *" Then  
            H2Txt = ""  
          Else
           H2Txt = Left(H2Txt, InStr(H2Txt, "^") - 1)  
          End If
         End If
          If IsDate(H2Txt) = True Then DText = Format(H2Txt, "dd.mm.yyyy")  
          If IsDate(H2Txt) = False Then DText = "01.01.1910"  
         If H3Txt Like "1*" Or H3Txt Like "2*" Or H3Txt Like "3*" Or H3Txt Like "4*" Or H3Txt Like "5*" Or H3Txt Like "6*" Or H3Txt Like "7*" Or H3Txt Like "8*" Or H3Txt Like "9*" Then  
          Anzahl = Left(H3Txt, InStr(H3Txt, "^") - 1)  
         Else
          Anzahl = 0
         End If
       End If
      End If
     If GNR > 0 Then
      With CurrentDb.OpenRecordset("Mitglieder")  
       .AddNew
        !GNR = GNR
        !LinNr = LNr
        If VN Like "" Then !Vorn = "K" Else !Vorn = VN  
        If NN Like "" Then !Nachn = "K" Else !Nachn = NN  
        !Gebdat = DText
        !Anzahl = Anzahl
        If Sex = "" Then !Sex = "o" Else !Sex = Sex  
       .Update
       .Close
      End With
     End If
    End If
    VN = ""  
    NN = ""  
    Geb = "00.00.0000"  
    Anzahl = 0
    Sex = ""  
    HTxt = ""  
    H2Txt = ""  
    H3Txt = ""  
    GNR = 0
  .MoveNext
  Wend
  .Close
 End If
 End With



End Function

Public Function Gastname_aktualisieren()
Dim HGNR As Long
Dim Hnam As String



Set RS = CurrentDb.OpenRecordset("Select LinNR, GNR, Vorn, Nachn From Mitglieder Where LinNr = 2")  

If Not RS.EOF Then
  RS.MoveFirst
  
  While Not RS.EOF
  If RS!Vorn Like "K" And RS!Nachn Like "K" Then  
    HGNR = RS!GNR
   
    Set RS2 = CurrentDb.OpenRecordset("Select KundLbNr, Navn From CAMPKUND Where KundLbNr = " & HGNR)  
    If Not RS2.EOF Then
      Hnam = Trim(RS2!Navn)
      If Not Hnam Like "" Then  
        RS.Edit
        RS!Nachn = Hnam
        RS.Update
      End If
    End If
    RS2.Close
    
  End If
  HGNR = 0
  Hnam = ""  
  RS.MoveNext
  Wend
End If
End Function