Outlook lijkt geblokkeerd te zijn. UPDATE

[markwat]

Jaren lang heeft het gewerkt, en opeens werkt het niet meer.
vanuit Excel zoekt hij namen in outlook, transporteert ze in een Userform, maar nu moet ik eerst outlook openen om hem op te laten zoeken.
het lijkt wel of excel geen bevoegdheid meer heeft.
Wat kan ik hier aan doen?
nieuwste Windows staat op mijn pc.
Outlook is daarna door een proces niet meer op te starten, excel staat geheel vast.
Na lang wachten komt de foutmelding.
om het proces te stoppen doe ik ctrl.alt.del om excel en outlook uit te zetten.

'ZoekContactInformatie
Sub ZoekContactInformatie(TeZoekenNaam As String)
    Dim olA As Outlook.Application
    Dim olNS As Namespace, olAB As MAPIFolder
    Dim Contact As Variant, NrContactsGevonden As Long

    Set olA = New Outlook.Application
    Set olNS = olA.GetNamespace("MAPI")
    Set olAB = olNS.GetDefaultFolder(olFolderContacts)
    Application.Volatile
    
'zoek contacten en stop deze in een lijst
    NrContactsGevonden = 0
    ReDim Contacts(1 To 14, 1 To 1)
    For Each Contact In olAB.Items
        If Contact.Class = olContact Then
            If InStr(LCase(Contact.FullName), LCase(TeZoekenNaam)) Then
                NrContactsGevonden = NrContactsGevonden + 1
                ReDim Preserve Contacts(1 To 14, 1 To NrContactsGevonden)
                If Contact.MiddleName <> "" Then
                    Contacts(1, NrContactsGevonden) = Contact.LastName & " " & Contact.MiddleName
                Else
                    Contacts(1, NrContactsGevonden) = Contact.LastName
                End If
                If Contact.FirstName <> "" Then Contacts(2, NrContactsGevonden) = Contact.FirstName
                If Contact.BusinessAddressStreet <> "" Then
                    Contacts(3, NrContactsGevonden) = Contact.BusinessAddressStreet
                Else
                    Contacts(3, NrContactsGevonden) = Contact.HomeAddressStreet
                End If
                If Contact.BusinessAddressPostalCode <> "" Then
                    Contacts(4, NrContactsGevonden) = Contact.BusinessAddressPostalCode
                Else
                    Contacts(4, NrContactsGevonden) = Contact.HomeAddressPostalCode
                End If
                If Contact.BusinessAddressCity <> "" Then
                    Contacts(5, NrContactsGevonden) = Contact.BusinessAddressCity
                Else
                    Contacts(5, NrContactsGevonden) = Contact.HomeAddressCity
                End If
                If Contact.Email1Address <> "" Then
                    Contacts(6, NrContactsGevonden) = Contact.Email1Address
                End If
            End If
        End If
    Next
    
'in geval dat meer dan 1 contact gevonden is laat deze zien zodat gekozen kan worden
If NrContactsGevonden > 1 Then
    Load UserForm1
    UserForm1.MaakUserFormKlaar NrContactsGevonden, Contacts
    UserForm1.Show
Else 'als er maar 1 contact gevonden is kopieer deze meteen naar de sheet
    GeselecteerdeNaam 1
  End If
 olA.Quit
End Sub

 

[edmoor]

Vreemd.
Dat zou een Windows update probleem zijn:
https://windowsjet.com/simple-instructions-to-fix-error-code-800706be-on-windows-5933/

 

[JEC.]

Is de outlook library in VBA nog aangevinkt?

Daarna zou je deze nog kunnen proberen

Set olAB = olNS.GetDefaultFolder(olFolderContacts)

aanpassen naar

Set olAB = olNS.GetDefaultFolder(10)

 

[OctaFish]

Bij mij werkt je code 'vanuit de doos', uiteraard zonder je formulier. Weet je op welke regel hij bij jou stopt?

 

[snb]

Alternatief:

Sub M_snb()
     For Each it In CreateObject("outlook.application").GetNamespace("MAPI").GetDefaultFolder(10).items
        MsgBox Join(Array(it.firstname, it.middlename, it.LastName, it.BusinessAddressStreet, it.HomeAddressStreet, it.BusinessAddressPostalCode, it.HomeAddressPostalCode, it.BusinessAddressCity, it.homeAddressCity, it.Email1Address), vbLf)
     Next
 End Sub

Het Userform zou ik pas gebruiken nadat alle gegevens uit Outlook zijn ingelezen.

 

[markwat]

deels geprobeerd, ik ga eerst office maar opnieuw installeren. ik kom hier op terug.
Bedankt alvast.

 

[markwat]

Alternatief:

Sub M_snb()
     For Each it In CreateObject("outlook.application").GetNamespace("MAPI").GetDefaultFolder(10).items
        MsgBox Join(Array(it.firstname, it.middlename, it.LastName, it.BusinessAddressStreet, it.HomeAddressStreet, it.BusinessAddressPostalCode, it.HomeAddressPostalCode, it.BusinessAddressCity, it.homeAddressCity, it.Email1Address), vbLf)
     Next
 End Sub

Het Userform zou ik pas gebruiken nadat alle gegevens uit Outlook zijn ingelezen.

dat kan ik altijd naderhand nog gaan veranderen. bedankt voor het meedenken.

 

[markwat]

Bij mij werkt je code 'vanuit de doos', uiteraard zonder je formulier. Weet je op welke regel hij bij jou stopt?

 

[markwat]

Het probleem loste zich op nadat ik Windows opnieuw heb geïnstalleerd.

 

[edmoor]

Waarom heb je eigenlijk Application.Volatile er in gezet?

 

[markwat]

Alternatief:

Sub M_snb()
     For Each it In CreateObject("outlook.application").GetNamespace("MAPI").GetDefaultFolder(10).items
        MsgBox Join(Array(it.firstname, it.middlename, it.LastName, it.BusinessAddressStreet, it.HomeAddressStreet, it.BusinessAddressPostalCode, it.HomeAddressPostalCode, it.BusinessAddressCity, it.homeAddressCity, it.Email1Address), vbLf)
     Next
 End Sub

Het Userform zou ik pas gebruiken nadat alle gegevens uit Outlook zijn ingelezen.

De formule was best wel leuk!!

Ik heb dik 500 adressen in outlook staan!!!:thumb:
ok ok ok ok ok ok ok ok ok ok .............:love::love::love: