Importation Calendrier Outlook et Format

Calvus

XLDnaute Barbatruc
Bonjour le Forum,

J'ai trouvé sur le net un fichier permettant l'importation d'un calendrier Outlook.
Le code fonctionne bien, sauf que je n'arrive pas à trouver le bon format pour utiliser la fonction Find.
En tout cas j'imagine que le problème vient du format.

Le but est de trouver la ligne correspondant à l'horaire de début de la date importée.

Merci
 

Pièces jointes

  • Import Calendrier Format.xlsm
    18.5 KB · Affichages: 45

Lone-wolf

XLDnaute Barbatruc
Bonjour Calvus :)

Un essai comme ceci, si j'ai bien compris

VB:
Dim DateStart As Date, Numcellule As Long, CurApp
Dim plage As Range, cel As Range

DateStart = currentAppointment.Start
CurApp = currentAppointment
Numcellule = 6

For each CurApp In myAppointments
Range("B" & Numcellule) = CurApp.Subject
Range("D" & Numcellule) = CurApp.End
Numcellule = Numcellule + 1
set plage = Range("a6:a28")
For each cel in plage
If DateStart Like "*" & cel.Offset(0, 0).Value Then _
cel.offset(0, 2) = DateStart
Next cel
Next CurApp
 

Calvus

XLDnaute Barbatruc
Bonsoir Lone-Wolf :), le forum,

Ça ne fonctionne pas hélas.. Du moins ce n'est pas le résultat escompté.
Ce que j'aimerais, c'est qu'un rendez-vous pris dans Outlook à 11h soit inscrit dans les cellules équivalentes (soit B10 à D10 dans l'exemple)
Un rendez-vous à 14h30 soit inscrit de même manière (B17 à D17)
Idem pour les dates de fin, de façon à pouvoir colorer la plage par la suite.
Retrouver le visuel du calendrier en fait.

Et Manu... Et Manu... tu fait la gueule ou quoi??? :rolleyes::D
Mais non ! Je n'étais pas là simplement :)

A bientôt :)
:p:p:D
 

Calvus

XLDnaute Barbatruc
Re,

TROP Content ! J'ai trouvé en me basant sur une partie de ton code. Tu m'as mis sur la bonne voie. ! Voici le code :
VB:
Option Explicit


Sub ContactDateCheck()
' mes rendez vous Outlook du jour
    Dim myOlApp As Outlook.Application
    Dim myNamespace As Outlook.Namespace
    Dim myContacts As Outlook.Items
    Dim myItems As Outlook.Items
    Dim myItem As Object
  
    Set myOlApp = CreateObject("Outlook.Application")
    Set myNamespace = myOlApp.GetNamespace("MAPI")
'   Set MesRDV = myNamespace.GetDefaultFolder(olFolderCalendar).Items

Dim strDate As Variant, strRestriction As Variant
Dim myAppointments As Object, currentAppointment As Object
    strDate = Range("D3")
    strRestriction = "(([Start] >= '" & strDate & " 12:00 am' AND [Start] <= '" & strDate & " 11:59 pm')"
    strRestriction = strRestriction & " OR ([End] > '" & strDate & " 12:00 am' AND [End] <= '" & strDate & " 11:59 pm')"
    strRestriction = strRestriction & " OR ([Start] < '" & strDate & " 12:00 am' AND [End] > '" & strDate & " 11:59 pm'))"
    strRestriction = strRestriction & " AND [Duration] > 0"
  
    If strDate = "" Then strRestriction = "[Start] = 1"    'no result
    Set myAppointments = myNamespace.GetDefaultFolder(olFolderCalendar).Items.Restrict(strRestriction)
    myAppointments.Sort "[Start]"
    ' myAppointments.IncludeRecurrences = True
Dim CurApp
Dim DateStart As Date, DateEnd As Date
    DateStart = strDate
Dim plage As Range, cel As Range
          
For Each currentAppointment In myAppointments
    If currentAppointment.Class = olAppointment And currentAppointment.Start >= DateStart Then
      
        DateStart = currentAppointment.Start
        DateEnd = currentAppointment.End
      
            Set plage = Range("a6:a28")
                For Each cel In plage
                    If TimeSerial(Hour(cel), Minute(cel), 0) = TimeSerial(Hour(DateStart), Minute(DateStart), 0) Then
                        cel.Offset(0, 1) = currentAppointment.Subject
                        cel.Offset(0, 2) = Right(DateStart, 8)
                    End If
                        If TimeSerial(Hour(cel), Minute(cel), 0) = TimeSerial(Hour(DateEnd), Minute(DateEnd), 0) Then
                            cel.Offset(0, 1) = currentAppointment.Subject
                            cel.Offset(0, 2) = Right(DateEnd, 8)
                        End If
            Next cel
    End If
Next
End Sub
Il y a juste la déclaration des variables dont je ne suis pas sûr. Du coup j'ai mis Variant, car ça ne fonctionnait pas avec Range ou Date.

Ne me reste plus qu'à trouver comment on peut colorer la plage de rendez vous trouvé, pour chaque rendez vous.

A bientôt :)
 

Lone-wolf

XLDnaute Barbatruc
Re

En PJ. Un classeur que j'avais fait pour créer des RDV. Dans le classeur, il y à déjà des noms inscrits. Fait une recherche, double-clique sur l'adresse mail dans la listbox (tu peux aussi afficher le rdv avec le bouton "Afficher"). Dans le 2ème formulaire, tu peux annuler le rdv en cliquand sur l'mage correspondante, ajouter une couleur en cliquand sur la petite flèche "Classer". Clique ensuite sur "Envoyer"; là outlook s'ouvre avec le rdv programmé.
 

Pièces jointes

  • Créer Réunions Outlook.zip
    792.1 KB · Affichages: 55

Calvus

XLDnaute Barbatruc
Bonjour Lone-Wolf ;), le forum,

Si tu te base d'après cette ligne : If TimeSerial(Hour(cel), Minute(cel), 0) = TimeSerial(Hour(DateStart), Minute(DateStart), 0) Then
cel.Interior.Color = RGB(195, 255, 0) par exemple
Merci, mais ce que je voulais, c'était colorer les plages de cellules pendant tout le rv, et ce sur une période d'une semaine.
C'est donc fait maintenant. Si quelqu'un veut le code, je peux le transmettre.

Merci pour l'envoi de ton fichier, que je n'arrive malheureusement pas à ouvrir.
Ça bug sur PtrSafe, me disant qu'il est attendu Sub ou fonction..

A bientôt
 

Discussions similaires

Statistiques des forums

Discussions
312 938
Messages
2 093 768
Membres
105 816
dernier inscrit
TASTET B