Ok. Das war nicht so klug von mir. Hier mein Code.

Private Sub Befehl2_Click()
RefreshGAL
End Sub

Sub RefreshGAL()
   
    If MsgBox("Sure you want to refresh table: tbl_GAL?", vbYesNo, "Attention") = vbYes Then
        MsgBox "Mind the Progressbar below - Press Okay", vbOKOnly, "GAL Refreshing started"
       
        Dim appOL As Object
        Dim oApp As Object
        Dim oGAL As Object
        Dim oContact As Object
        Dim oUser As Object
        Dim arrUsers(1 To 65000, 1 To 11) As String
        Dim UserIndex As Long
        Dim i As Long
        Dim rs As DAO.Recordset
        Dim DB As DAO.Database
        Set DB = CurrentDb()
       
        On Error Resume Next  ' Ignore Errors
        Set oApp = GetObject(, "Outlook.Application") 'Wants to provoke an Error if Outlook is started
        If Err.Number = 0 Then 'Tests if Outlook is started
           MsgBox ("Please close Outlook!")
        Else 'Starts the Import if Outlook is closed
       
          
       
            Set appOL = CreateObject("Outlook.Application")
            Set oGAL = appOL.GetNamespace("MAPI").AddressLists("Globale Adressliste").AddressEntries
           
            SysCmd acSysCmdInitMeter, "GAL Refreshing: ", oGAL.Count
           
            Set rs = DB.OpenRecordset("tbl_GAL", dbOpenDynaset, dbSeeChanges)
            For i = 1 To oGAL.Count ' Fügt alle Einträge ein
                SysCmd acSysCmdUpdateMeter, i
       
                Set oContact = oGAL.Item(i)
                If oContact.AddressEntryUserType = 0 Then
                    Set oUser = oContact.GetExchangeUser
                   ' If Len(oUser.LastName) > 0 Then
                   Debug.Print oUser.FirstName
                   If oUser.LastName = "Blechinger" And oUser.FirstName = "Heinz" Then
                   MsgBox oUser.Fristname
                        UserIndex = UserIndex + 1
                        rs.AddNew
                      
                            'rs![Key-GAL] = UserIndex
                            rs!FamilyName = oUser.LastName
                            rs!FirstName = oUser.FirstName
                           ' rs!EmailAddress = oUser.PrimarySmtpAddress
                          '  rs!Alias = oUser.Alias
                           ' rs!Location = oUser.City
                           ' rs!department = oUser.department
                            'rs!PhoneNumber = oUser.BusinessTelephoneNumber
                            'rs!LastUpdate = Date
                        rs.Update
                        Debug.Print "User: " & UserIndex & oUser.LastName & " wurde geschrieben."
                    End If
                End If
          Next i
            rs.Close
            SysCmd acSysCmdRemoveMeter
       
            appOL.Quit
       
            Set appOL = Nothing
            Set oGAL = Nothing
            Set oContact = Nothing
            Set oUser = Nothing
            Erase arrUsers
                
            'Set DB = Nothing
            'Set rs = Nothing
           
           Err.Clear  ' Vorherige Fehlernummer löschen
        
        End If 'End if of the "Is Outlook open" check
    Else
        MsgBox "You quit refreshing tbl_GAL.", vbOKOnly
   End If
End Sub

Ich erhalte keine Fehlermeldung(Laufzeitfehler oder Beschreibung), es tut sich nichts, auch keine Einträge im Direktfenster.

Bitte entschuldigt mein Ungeschicklichkeit bei der Fragestellung.