Deux soucis sur une exportation de date vers outlook (voir dernier post)

[Abardothe]

Bonjour (ou re-bonjour) tout le monde ! 😀

J'ai créé un fichier excel qui me permet d'obtenir les dates de mes futurs échéances pour de la maintenance. Et je voudrais que les dates ainsi obtenues soient exporter vers excel où elles me créront un rendez vous (de 1h à 08h00 par exemple).

Pour être plus concis, je voudrais que les dates présentes dans la colonne H de mon fichier soient exporter vers outlook.

J'ai trouvé deux codes différents sur internet mais je n'arrive pas à les adapter à mon fichier et je ne les comprend pas vraiment. Est-ce que vous pourriez me les expliquer ou créer un nouveau code en me l'expliquant ? Je vous remercie d'avance pour l'aide que vous apporter à MA VIE 😉

1er code :

Sub NouveauRDV_Calendrier()
 'nécéssite d'activer la référence Microsoft Outlook 10.0 Object Library
 Dim myOlApp As New Outlook.Application
 Dim MyItem As Outlook.AppointmentItem
  
 Set MyItem = myOlApp.CreateItem(olAppointmentItem)
  
 With MyItem
     .MeetingStatus = olMeeting
     .Subject = "le forum xld"
     .Body = "...description ...."
     .Location = "sur le chat"
     .Start = #8/7/2006 9:30:00 PM#     ' Attention : format mois/jours/année
     .Duration = 30 'minutes
     .Categories = "Amis"
     .Save
 End With
  
 Set myOlApp = Nothing
 End Sub

2ème code :

Sub Outlook()
Dim myOlApp As New Outlook.Application
Dim myItem As Outlook.AppointmentItem
Dim Cell As Range
Dim myConflicts As Outlook.Conflicts
 
For Each Cell In Range("h8:b" & Cells(Rows.Count, 7).End(xlUp).Row)
Set myItem = myOlApp.CreateItem(olAppointmentItem)
 
With myItem
.MeetingStatus = olNonMeeting
.Subject = Cells(17, 9) & " - " & Cell.Value & " krad"
.Start = Cell.Offset(0, 6) 'Format(Cell.Offset(0, 6), "MM/DD/YYYY") ' Attention : format mm/dd/yy
.Duration = Hour(Cell.Offset(0, 8)) * 60 + Minute(Cell.Offset(0, 8)) 'minutes
.Location = "test"
.ReminderMinutesBeforeStart = 60
.Save
End With
Set myItem = Nothing
Next Cell
End Sub

 

[Guest]

Re : Deux soucis sur une exportation de date vers outlook (voir dernier post)

Re,

Grand salut mon ami l'agrafe🙂

et pour découvrir que celui-ci est plutôt enclin à Ce lien n'existe plus 😉

C'est juste contextuel. en l'occurence le demander mélangeait les deux aussi j'ai coupé dans le vif sans demander de précision(aïe).

Parfois je fais du early binding pour trouver avec l'intellisens, et l'explorateur de projet les objets,méthodes, propriétés et constantes puis je passe tout en late binding, lorsque je ne connais pas la librairie du demandeur.

Enfin, ça dépend de la forme et de l'envie.

Abardothe semblait bien seul sur le coup, sa ténacité meritait bien que l'on s'y attardât.

a++++

 

[Abardothe]

Re : Deux soucis sur une exportation de date vers outlook (voir dernier post)

Bonjour ! 😀

Retour du WE et petit test, pas très concluant malheureusement..

Tout d'abord j'ai lancé ton mini programme sur un fichier excel à part. J'ai du tout d'abord rajouter des références outlook qui n'étaient pas cochés. Mais ensuite lorsque je lance la macro cela ne donne pas de résultats. Et quand je fais "afficher les macros" il m'affiche que : initOutlook et nettoieOutlook mais pas ListerFolders. Peut être normal je sais pas... Peux tu me dire quelle procédure exécuter ?

Ensuite pour mon fichier excel, lorsque je lance la macro cela m'indique un message d'erreur :

Erreur d'exécution '-2147221233 (8004010f)'
Echec de l'opération. Impossible de trouver un objet

Tout ça en me surlignant la ligne suivante :

Set MyCalendarFolder = olns.Folders("pierre.mauj***@***.fr").Folders("Calendriers").Folders("Mes calendriers").Folders("maintenance

C'est dû à quoi ? Moi qui n'arrive pas à donner le bon chemin pour le calendrier ? Ou une erreur d'écriture de macro ?



Je donne la macro complète ici :

Option Explicit

Sub AjoutRV()
  Dim DLig As Long, Lig As Long
  Dim OutObj As Outlook.Application
  Dim OutAppt As Outlook.AppointmentItem
  Dim DateRdv As Date, FlgRdv As Boolean
  Dim MyCalendar As Outlook.Items
  Dim OutlMapi As Outlook.Namespace
  Dim OutlFolder As Outlook.MAPIFolder
  Dim MyItem As Outlook.AppointmentItem
  Dim myNamespace As Outlook.Namespace
  Dim myOlApp As New Outlook.Application
 
  ' Créer une instance d'Outlook
  Set OutObj = CreateObject("outlook.application")
  ' Avec la feuille
  With Sheets("Suivi")
    DLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne
    For Lig = 12 To DLig
      ' Vérifier si pas déjà fait
      If .Range("D" & Lig) <> "" Then
      Else
        FlgRdv = True
      End If
      ' Si le FLAG est à vrai on créé le RDV
      If FlgRdv Then
       'création du rdv

Dim olns As Outlook.Namespace
     Dim MyCalendarFolder As Outlook.MAPIFolder
     
    'si outlook est référencé dans outils/référence
     'pas besoin de CreateObject, la ligne ci-dessous suffit à créer l'objet Outlook.Application
     Dim objOutlook As New Outlook.Application
     
    'initialisation du NameSpace
     Set olns = objOutlook.GetNamespace("MAPI")
     
    'Optention du calendrier en utilisant la constante (sinon mettre le nom du calendrier entre guillemets)
     Set MyCalendarFolder = olns.Folders("pierre.mauj**@***.fr").Folders("Calendriers").Folders("Mes calendriers").Folders("maintenance")
     
     
     
        DateRdv = Range("B" & Lig) 'date du rdv, ici prend la colonne B
        Set OutAppt = OutObj.CreateItem(olAppointmentItem)
        With OutAppt
          .Subject = "Maintenance " & Sheets("Suivi").Range("A" & Lig) & " pour le suivi " & Sheets("Suivi").Range("C" & Lig) 'sujet du rdv
          .Start = DateRdv & " 08:00 " 'Début du rendez-vous
          .Duration = 60 'durée en minute du rdv
          .Body = Range("F" & Lig)
          .ReminderSet = True 'présence ou non d'un rappel (True/False)
          .Save
        End With
        ' Créer le commentaire et inscrire Oui
        On Error Resume Next
        .Range("D" & Lig).Comment.Delete
        .Range("D" & Lig) = "Rdv créé"
        On Error GoTo 0
      End If
    Next Lig
  End With
  Set OutAppt = Nothing
    Set MyCalendarFolder = Nothing
     Set olns = Nothing
     Set objOutlook = Nothing
     
End Sub

Merci d'avance si tu arrives encore à m'aider.. 😀


Edit : Faut-il utiliser la fonction "item" ? Je l'ai vu apparaitre à plusieurs endroits
Edit 2 : J'ai copier l'adresse de l'emplacement sur l'explorateur de document, et cela me met une erreur, est-ce que ça peut être dû à un problème de réseau et n'a donc plus rien à voir ici ?

 

[Abardothe]

Re : Deux soucis sur une exportation de date vers outlook (voir dernier post)

Je fais un nouveau poste, sinon ce ne serait pas compréhensible...

Je crois avoir réussi à mettre le bon chemin d'accès, mais le rendez vous s'écrit quand même dans le calendrier de base.
Est-ce que mon code est mauvais plus bas ?
Je vous remet mon fichier Excel en pièce jointe



EDIT : je fais plein d'EDIT vu que je pose la question avant de faire des recherches.. Je pense que mon soucis c'est que j'ai choisi le "folder" où inscrire le rendez-vous, mais je dis pas qu'il faut créer le rendez vous dans ce dossier, du coup il doit y avoir une fonction toute simple qui doit le permettre, mais je suis toujours aux bafouillement du VBA.. Aurais-tu la solution ?

 

[Abardothe]

Re : Deux soucis sur une exportation de date vers outlook (voir dernier post)

Petite image pour illustrer le problème que j'ai avec ton mini programme..





Je sais que je fais beaucoup de poste pour pas grand chose, mais j'essaie de motiver ainsi des gens à m'aider en leur montrant que je n'attend pas bêtement la réponse.. Je cherche aussi de mon coté..

Bonne soirée.

 

[Abardothe]

Re : Deux soucis sur une exportation de date vers outlook (voir dernier post)

Après une super soirée et une matinée matinale...

Voici le résultat qui fonctionne !

Sub creer_rdv()

Dim objOutlook As Outlook.Application
Dim objAppt As Outlook.AppointmentItem
Dim olns As Outlook.Namespace
Dim MycalendarFolder As Outlook.MAPIFolder
Dim MyFolder As Outlook.Items
 
Set objOutlook = CreateObject("Outlook.Application")
Set olns = objOutlook.GetNamespace("MAPI")
Set MycalendarFolder = olns.GetDefaultFolder(olFolderCalendar)

' Créer une instance d'Outlook
   Set OutObj = CreateObject("outlook.application")
   ' Avec la feuille
   With Sheets("Suivi")
     DLig = .Range("A" & Rows.Count).End(xlUp).Row
     ' Pour chaque ligne
     For Lig = 12 To DLig
       ' Vérifier si pas déjà fait
       If .Range("D" & Lig) <> "" Then
       Else
         FlgRdv = True
       End If
       ' Si le FLAG est à vrai on créé le RDV
       If FlgRdv Then
        'création du rdv
 'Selectionne le calendrier

Set MyFolder = olns.Folders("archive1").Folders("test").Items

Set objAppt = MyFolder.Add
'Cree le rendez vous
With objAppt
 
   DateRdv = Range("B" & Lig) 'date du rdv, ici prend la colonne B
  .Start = DateRdv & " 08:00 " 'Début du rendez-vous
  .Duration = 60
  .Subject = "Maintenance " & Sheets("Suivi").Range("A" & Lig) & " pour le suivi " & Sheets("Suivi").Range("C" & Lig) 'sujet du rdv
  .Body = Range("F" & Lig)
  'Ajoute le rappel
    .ReminderMinutesBeforeStart = 1440
    .ReminderSet = True
  
  'Sauvegarde et ferme
  .Save
  .Close (olSave)
End With
  ' Créer le commentaire et inscrire Oui
         On Error Resume Next
         .Range("D" & Lig).Comment.Delete
         .Range("D" & Lig) = "Rdv créé"
         On Error GoTo 0
       End If
     Next Lig
     End With
'Libération des variables.
Set objAppt = Nothing
Set objOutlook = Nothing
MsgBox "Rdv ajouté!"
Exit Sub
'Gere les erreurs
Add_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
End Sub

Je suis allé ici Les meilleures sources Access et j'ai repris tout depuis le début 😀

Merci à toi Hasco même si je pense que tu devais en avoir un peu marre de moi à la fin ^^

Bisous et bonne continuation ! 🙂

 

[Guest]

Re : Deux soucis sur une exportation de date vers outlook (voir dernier post)

Bonjour et Merci de ce retour qui aidera certainement d'autres personnes.

toutefois, il reste que dans ta macro tu crées 2 instances d'outlook

la première nommée objOutlook et créée par CreateObject("Outlook.Application")
la deuxième nommée outObj et créée par la même méthode

Comme dis dans un post précédent, si tu travailles en référençant la librairie Outlook, tu n'as pas besoin de CreateObject (cela rentre souvent en conflit même si théoriquement cela est possible!).

Il faut lire les réponses et essayer de comprendre en se documentant sur la différence entre 'Liaison tardive" et "Liaison anticipée". Va lire cette doc: Les fiches VBA - Comprendre : Early ou Late Binding

Ci-dessous la macro avec des déclarations en liaison anticipée (early binding) et débarassées des multiples variables objet inutiles:

Sub AjoutRV()
'Variables de fonctionnement général
    Dim DateRdv As Date, FlgRdv As Boolean
    Dim DLig As Long, Lig As Long
    
    'Variables outlook
    Dim objOutlook As Outlook.Application
    Dim olNs As Outlook.Namespace
    Dim OutAppt As Outlook.AppointmentItem
    Dim MyCalendar As Outlook.Items
    
    'initialisation de l' objet application Outlook et de l'espace de noms
    Set objOutlook = New Outlook.Application
    Set olNs = objOutlook.GetNamespace("MAPI")
    
    ' Avec la feuille
    With Sheets("Suivi")
        DLig = .Range("A" & Rows.Count).End(xlUp).Row
        ' Pour chaque ligne
        For Lig = 12 To DLig
            ' Vérifier si pas déjà fait
            If .Range("D" & Lig) <> "" Then
            Else
                FlgRdv = True
            End If
            ' Si le FLAG est à vrai on créé le RDV
            If FlgRdv Then
                'Optention du calendrier en utilisant la constante (sinon mettre le nom du calendrier entre guillemets)
                Set MyCalendarFolder = olNs.Folders("[EMAIL="pierre.mauj**@***.fr").Folders("Calendriers").Folders("Mes"]pierre.mauj**@***.fr").Folders("Calendriers").Folders("Mes[/EMAIL] calendriers").Folders("maintenance")
                
                DateRdv = Range("B" & Lig)    'date du rdv, ici prend la colonne B
                Set OutAppt = objOutlook.CreateItem(olAppointmentItem)
                With OutAppt
                    .Subject = "Maintenance " & Sheets("Suivi").Range("A" & Lig) & " pour le suivi " & Sheets("Suivi").Range("C" & Lig)    'sujet du rdv
                    .Start = DateRdv & " 08:00 "    'Début du rendez-vous
                    .Duration = 60    'durée en minute du rdv
                    .Body = Range("F" & Lig)
                    .ReminderSet = True    'présence ou non d'un rappel (True/False)
                    .Save
                End With
                ' Créer le commentaire et inscrire Oui
                On Error Resume Next
                .Range("D" & Lig).Comment.Delete
                .Range("D" & Lig) = "Rdv créé"
                On Error GoTo 0
            End If
        Next Lig
    End With
    Set objOutlook = Nothing
    Set olNs = Nothing
End Sub

Pour le petit module donné plus haut et qui liste les dossiers Outlook, la voici avec quelques commentaires supplémentaire et un passage des sub en Private Sub.

 Option Explicit
Private objOutlook As Outlook.Application
Private olns  As Outlook.Namespace

'Macro exemple de lancement de ListerFolder cette seule macro apparaitra dans la liste des macros
Public Sub DossiersOutlook()
    ListerFolders ActiveCell 'Listera dans la cellule active
    'ListerFolders Sheets("Feuil2").Range("C10") 'listera dans C10 de la feuille Feuil2
End Sub

'les Sub 'Private' n'apparaissent pas dans la liste des macros
 Private Sub initOutlook()
     Set objOutlook = New Outlook.Application
     Set olns = objOutlook.GetNamespace("MAPI")
 End Sub
 
 Private Sub ListerFolders(Cellule As Range, Optional ParentFolders As Outlook.Folders)
     Dim Folder As Outlook.MAPIFolder
     If objOutlook Is Nothing Then initOutlook
     If ParentFolders Is Nothing Then Set ParentFolders = olns.Folders
     For Each Folder In ParentFolders
         Cellule = Folder.FolderPath
         Set Cellule = Cellule.Offset(1)
         If Folder.Folders.Count > 0 Then ListerFolders Cellule, Folder.Folders
     Next
     nettoieOutlook
 End Sub
 Private Sub nettoieOutlook()
     Set olns = Nothing
     Set objOutlook = Nothing
 End Sub

Je sais bien que tu as un résultat de stage à communiquer, mais prend un peu de temps pour comprendre tout ça, que tu sois au moins capable de voir ce qui ne va pas si ta macro plante en démonstration.

A+

P.S. parfois je semble connecté au forum, mais seul mon ordi l'est... alors si je ne réponds pas...patiente