IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Nouveau Candidat au Club
    Homme Profil pro
    Ingénieur qualité méthodes
    Inscrit en
    novembre 2020
    Messages
    2
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 27
    Localisation : France, Hauts de Seine (Île de France)

    Informations professionnelles :
    Activité : Ingénieur qualité méthodes
    Secteur : Industrie

    Informations forums :
    Inscription : novembre 2020
    Messages : 2
    Points : 1
    Points
    1
    Par défaut envoyer une réunion avec la deuxième adresse mail depuis une macro Excel.
    Bonjour le forum,

    J'ai un programme Excel qui me permet de comparer l'emploi du temps de 2 personnes, puis lorsqu'un créneau est disponible, il envoi une demande de réunion. Il y a tout un tableau de rdv et cela s’exécute pour toutes les lignes.

    Mon soucis, c'est qu'il y a 2 adresses mail de connectées, et je souhaite que la réunion soit créé avec le deuxième compte. C'est important parce que ce compte est utilisé pour la prise de rdv et ne pas polluer l'emploi du temps du compte principal. Ce 2ème compte peut être utilisé par plusieurs personnes.

    J'ai essayé de plusieurs façons et plusieurs code en fouillant sur le web et le 2 techniques principales que j'ai trouvé sont :
    - passer par la partie calendrier. Cad choisir le bon calendrier dessus puis ajouter la réunion.
    - choisir le bon compte puis ajouter une réunion.

    Dans les 2 cas je retombe toujours sur le compte principal (j'ai inversé les adresses mails et j'ai mis l'adresse pour la création de rdv en adresse principal et l'adresse de la personne, la mienne pour le coup, en second et j'ai encore créé sur l'adresse principal). Je suis sûr que c'est possible car manuellement je peux créer une réunion sur le bon calendrier mais je ne parviens pas à le coder. C'est pour quoi après avoir pas mal cherché, je me tourne vers vous le forum =).

    Je vous met les codes que j'ai essayé avec quelques commentaires.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    Sub SendEmailFromSharedMailbox()
    Dim olApp As Outlook.Application
        Set olApp = Outlook.Application
     
    Dim olNS As Outlook.Namespace
      Dim objOwner As Outlook.Recipient
     
      Set olNS = olApp.GetNamespace("MAPI")
      Set objOwner = olNS.CreateRecipient("creation.rdv@outlook.com")
        objOwner.Resolve
     
     If objOwner.Resolved Then
       'MsgBox objOwner.Name
     Set newCalFolder = olNS.GetSharedDefaultFolder(objOwner, olFolderCalendar)
     
    'Now create the email
     Set olAppt = newCalFolder.Items.Add(olAppointmentItem)
         With olAppt
         'Define calendar item properties
            .Start = "07/11/2020 2:00 PM"
            .End = "07/11/2020 2:30 PM"
            .Subject = "Appointment Subject Here"
            .Recipients.Add ("personne.un@outlook.com")
            '.SendUsingAccount = "creation.rdv@outlook.com"   J'ai essayé en rajoutant cette ligne mais ça ne change rien pour la création de réunion. En revanche ça fonctionne quand il s'agit de mail ...
            'Add more variables as required, eg reminder, importance, etc
            .Display
        End With
     End If
     
    End Sub
    Le deuxième code que j'ai essayé

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
     
    Sub AjoutDansCalendrier(xCalendrier, xTitre, xHeurDeb, xDuree, xLieu, xBody, mailFormateur, mailNouvelArrivant, xTrouve)
     
    'On Error Resume Next
     
    '=======================================================================================
     
    ' Création d'un RDV sur Agenda OUTLOOK
     
    '=======================================================================================
     
    Dim olApp As Outlook.Application
     
    Dim objNS As Outlook.Namespace
     
    Dim objExpCal As Outlook.Explorer
     
    Dim objNavMod As Outlook.CalendarModule
     
    Dim ObjNavCalPart As Outlook.NavigationFolders
     
    Dim objNavFolder As Outlook.NavigationFolder
     
    Dim FolderPartage As Outlook.Folder
     
    Dim F
     
    'Dim xTrouve As Boolean
     
    Set olApp = CreateObject("outlook.application")
     
    Set objNS = olApp.Session
     
    Set objExpCal = objNS.GetDefaultFolder(olFolderCalendar).GetExplorer
     
    Set objNavMod = objExpCal.NavigationPane.Modules.GetNavigationModule(olModuleCalendar)
     
     
    '--------------------------------------------------------------------------------------
     
    ' Parcours la liste des familles de calendrier et les calendriers de chaque famille
     
    '--------------------------------------------------------------------------------------
    xCalendrier = "Calendrier"
    xTrouve = False
     
    xNbrFamCal = objNavMod.NavigationGroups.Count
     
    For F = 1 To xNbrFamCal
     
        xNbrSousCal = objNavMod.NavigationGroups.Item(F).NavigationFolders.Count
     
        For G = 1 To xNbrSousCal
            If G = 1 And F = 1 Then
                GoTo calendrier_suivant
            End If
     
            xNomFamilleCal = objNavMod.NavigationGroups.Item(F).Name
            xNomCalendrier = objNavMod.NavigationGroups.Item(F).NavigationFolders.Item(G).DisplayName
     
            If xNomCalendrier = xCalendrier Then
     
                'On Error Resume Next
     
                Set ObjNavCalPart = objNavMod.NavigationGroups.Item(xNomFamilleCal).NavigationFolders
                Set objNavFolder = ObjNavCalPart(xCalendrier)
                Set MonSousDoss = ObjNavCalPart(G)
     
                'FoldName = MonSousDoss.Folder.Name & "-" & MonSousDoss.Folder.FullFolderPath
     
                If Err Then
     
                    xTrouve = False
     
                    MsgBox "Calendrier : " & xCalendrier & " non accéssible !!!", vbCritical, "ERREUR"
     
                Else
     
                    xTrouve = True
                    xMess = Empty
     
                End If
     
            Exit For
     
            Else
                xTrouve = False
            End If
    calendrier_suivant:
        Next G
     
        If xTrouve = True Then
            Exit For
        End If
     
    Next F
     
    'If xTrouve = False Then
    '    MsgBox "Calendrier : " & xCalendrier & " non trouvé !!!!", vbCritical, "CALENDRIER"
    '    Exit Sub
    'End If
     
     
    '--------------------------------------------------------------------------------------
     
    ' Suite
     
    '--------------------------------------------------------------------------------------
     
    If MonSousDoss <> Empty Then
     
    Set FolderPartage = objNavFolder.Folder
     
    On Error GoTo 0
     
    '---------------------------------------------------------
     
    ' Création du RDV
     
    '---------------------------------------------------------
     
    Dim ObjRDV As Outlook.AppointmentItem
     
    Set ObjRDV = FolderPartage.Items.Add
     
    xStart = xHeurDeb
     
    With ObjRDV
     
    .Subject = xTitre
     
    .SendUsingAccount = objNS.Session.Accounts.Item(2)
     
    .MeetingStatus = olMeeting
     
    .body = xBody
     
    .Start = xStart
     
    .Duration = xDuree 'Valeur entière (exemple 30) exprimée en minutes
     
    .Location = xLieu
     
    '.Send
     
    Set myRequiredAttendee = ObjRDV.Recipients.Add(mailFormateur)
    myRequiredAttendee.Type = olRequired
    Set myOptionalAttendee = ObjRDV.Recipients.Add(mailNouvelArrivant)
    myOptionalAttendee.Type = olRequired
    If xLieu Like "*salle*" Or xLieu Like "*fgr*" Or xLieu Like "*sds*" Then
        Set myResourceAttendee = ObjRDV.Recipients.Add(xLieu)
        myResourceAttendee.Type = olRequired
    End If
     
    .Display 'Mettre en commentaire après mise au point
    '.Save
     
    End With
     
    End If
     
    End Sub

    Merci d'avance pour votre aide

  2. #2
    Expert éminent
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    mars 2006
    Messages
    4 081
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 4 081
    Points : 7 033
    Points
    7 033
    Billets dans le blog
    20
    Par défaut
    Le premier code me semble pas mal!
    mais si tu ajoutes le user , c'est normal qu'il le retrouve dans son calendrier !

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
     .Recipients.Add ("personne.un@outlook.com")

  3. #3
    Nouveau Candidat au Club
    Homme Profil pro
    Ingénieur qualité méthodes
    Inscrit en
    novembre 2020
    Messages
    2
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 27
    Localisation : France, Hauts de Seine (Île de France)

    Informations professionnelles :
    Activité : Ingénieur qualité méthodes
    Secteur : Industrie

    Informations forums :
    Inscription : novembre 2020
    Messages : 2
    Points : 1
    Points
    1
    Par défaut
    Bonjour Oliv,

    Cette ligne concerne les personnes invitées à la réunion.

    J'ai 2 comptes, A et B. Si A est l'adresse principal alors la réunion (AppointmentItem) ce crée dans le calendrier de A. Si B est le compte principal, alors la réunion est sur Calendrier de B. Ce que je souhaite c'est cette réunion (AppointmentItem) soit systématiquement sur B. Je ne parviens pas à changer le comte qui crée la réunion. Même avec la fonction SendUsingAccount.

    En revanche cette fonction marche avec les mails. La différence c'est que quand on crée une réunion, on ne peut pas changer la personne qui l’envoie, même manuellement. Il faut se placer dans le bon calendrier. Ce que je ne parviens pas à faire sur VBA.

    Du coup, comment je peux faire pour que ma réunion soit sur le calendrier de creation.rdv@outlook.com (le compte B que j'ai cité au-dessus) plutôt que sur le calendrier du compte principal (le compte A : nouvel.arriviste@outlook.com).

    Cordialement

  4. #4
    Expert éminent
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    mars 2006
    Messages
    4 081
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 4 081
    Points : 7 033
    Points
    7 033
    Billets dans le blog
    20
    Par défaut
    Chez moi ce code fonctionne
    j'ai ajouté la ligne .MeetingStatus = olMeeting

    attention pour que cela marche il faut que la personne qui lance le code ait les droits suffisants sur la boite partagée qui va être le propriétaire de la réunion.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    Sub MeetingFromSharedMailbox()
        Dim olApp As Outlook.Application
        Set olApp = Outlook.Application
        Dim olAppt As Outlook.AppointmentItem
     
        Dim olNS As Outlook.NameSpace
        Dim objOwner As Outlook.Recipient
     
        Set olNS = olApp.GetNamespace("MAPI")
        Set objOwner = olNS.CreateRecipient("creation.rdv@outlook.com")
        objOwner.Resolve
     
        If objOwner.Resolved Then
            'MsgBox objOwner.Name
            Set newCalFolder = olNS.GetSharedDefaultFolder(objOwner, olFolderCalendar)
     
            'Now create the email
            Set olAppt = newCalFolder.Items.add(olAppointmentItem)
            With olAppt
     
                'Define calendar item properties
                .Start = "17/11/2020 3:00 PM"
                .End = "17/11/2020 3:30 PM"
                .Subject = "Appointment Subject Here"
                .MeetingStatus = olMeeting
                .Recipients.add ("nouvel.arriviste@outlook.com")
     
                'Add more variables as required, eg reminder, importance, etc
                .Display
                .Send
            End With
        End If
     
    End Sub

Discussions similaires

  1. [XL-2003] Envoyer mail depuis un serveur par une macro excel
    Par jabranejb dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 28/11/2012, 14h25
  2. [Hijackthis] - Mail intempestif avec ma propre adresse mail.
    Par zeralium dans le forum Sécurité
    Réponses: 0
    Dernier message: 27/05/2009, 10h33
  3. Macro Outlook qui lance une Macro Excel qui veut envoyer un mail = Bug
    Par Lameth dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 18/07/2008, 10h21
  4. envoyer une macro VBS dans un email
    Par ricotrutt dans le forum VBScript
    Réponses: 14
    Dernier message: 28/07/2006, 15h04
  5. Réponses: 1
    Dernier message: 03/12/2005, 16h17

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo