none
[Access2010] & [Outlook2010] : ouvrir et enregistrer un nouveau contact dans un dossier autre que celui par défaut RRS feed

  • Question

  • Bonjour

    Avec le code ci-dessous affecté à un bouton dans ma base acces, je peux ouvrir la fiche nouveau contact
    dans outlook.. Quand j'enregistres le contact, il va se placé dans le dossier de
    contact par défaut..

    Comment lui indiquer un autre dossier situé dans
    une Bal gérée ?

    (mabalgeree@fai.com/modossiercontactsperso)

    Public Function StartOutLook()
        On Error GoTo StartOutLook_Error
        Dim spObj As Object, MyItem As Object
    
        ' Créer un objet Microsoft OutLook.
        Set spObj = CreateObject("Outlook.Application")
    
        ' Créer et ouvrir un nouveau formulaire pour l'entrée du contact.
        ' Vous pouvez substituer olAppointmentItem, olJournalItem, olMailItem,
        ' olNoteItem, olPostItem, ou olTaskItem à olContactItem.
         Set MyItem = spObj.CreateItem(olContactItem)
         MyItem.Display
    
        ' Quitter Microsoft Outlook.
         Set spObj = Nothing
         Exit Function
    
     StartOutLook_Error:
        MsgBox "Error: " & Err & " " & Error
        Exit Function
     End Function 

    mercredi 27 février 2013 14:50

Réponses

  • j'ai trouvé la solution

    Function IsOutLookRunning()
        Dim MyOL As Object
        On Error Resume Next    ' Defer error trapping.
        ' Getobject function called without the first argument returns a
        ' reference to an instance of the application. If the application isn't
        ' running, an error occurs.
        Set MyOL = GetObject(, "Outlook.Application")
        If Err.Number <> 0 Then
            IsOutLookRunning = False
            MyOL.Quit
        Else
            IsOutLookRunning = True
        End If
        Set MyOL = Nothing
    End Function
    
    
    Public Function StartOutLook()
     'déclaration des variables de travail
        Dim olknamespace As NameSpace
        Dim olkapp As Outlook.Application
        
        Dim objOLfolder As MAPIFolder
        Dim objMnfolder As MAPIFolder
        Dim olMnfolder As MAPIFolder
        
        
        Dim itms As Outlook.Items
        Dim olkItem As Outlook.ContactItem
        Dim i As Long
     
          If Not IsOutLookRunning() Then
             Dim oShell As Object
             Set oShell = CreateObject("WScript.Shell")
             oShell.Run "outlook"
             Set oShell = Nothing
          End If
     
        'ouverture de l'object outlook
     
        Set olkapp = CreateObject("Outlook.application")
        Set olknamespace = olkapp.GetNamespace("MAPI")
     
        'ouverture des dossiers de contacts
     
        Set olMnfolder = olknamespace.Folders(NomBAL)
        Set objOLfolder = olMnfolder.Folders(NondossContacts)
     
        Set olkItem = objOLfolder.Items.Add(olContactItem)
        olkItem.Display
     
        Set olkItem = Nothing
     
        'fermeture et libération des objets
        Set objOLfolder = Nothing
        Set objMnfolder = Nothing
     
        Set olknamespace = Nothing
        Set olkapp = Nothing
    End Function
    

    • Marqué comme réponse Seb.......95 lundi 4 mars 2013 15:41
    lundi 4 mars 2013 15:41