Création/Suppression de RDV outlook via Excel

Y compris Power BI, Power Query et toute autre question en lien avec Excel
K
Kompa01
Nouveau venu
Nouveau venu
Messages : 6
Inscrit le : 4 janvier 2019
Version d'Excel : 2016

Message par Kompa01 » 4 janvier 2019, 08:55

Bonjour.

J'ai un souci sur une macro faites pas un ancien de chez nous qui fonctionnais parfaitement avant l’installation de office 365 sur nos nouveaux postes (excel 32).
Cette Macro sert à supprimer des RDV sur Outlook via une base de données Excel.
Elle marque maintenant une Erreur 13 au niveau de la ligne "If c <> "" Then"

En tout cas merci d'avance pour votre aide/conseils et bon année à tous.

Voici ci dessous le code utilisé :
    'Variables de fonctionnement
    Dim c As Range    'variable objet Range de la cellue en cours de boucle
    'nécéssite d'activer la référence Microsoft Outlook 10.0 Object Library
    Dim OlApp As New Outlook.Application    'déclaraction et création (New) de l'instance Outlook
    Dim OlMapi As Outlook.Namespace
    Dim OlFolder As Outlook.MAPIFolder
    Dim OlAppointment As Outlook.AppointmentItem
    'Initialisation des variables
    Set OlMapi = OlApp.GetNamespace("MAPI")
    Set OlFolder = OlMapi.GetDefaultFolder(olFolderCalendar)
    
    'Travail sur la feuille 'Calendrier'
    With Sheets("Calendrier")    'mettre le nom de la feuille en remplacement de Feuil1
        'Parcourir les cellules de la colonne A de la ligne 2 à la dernière ligne occupée
        For Each c In .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
            'Si la cellule n'est pas vide
            If c <> "" Then
                'Parcourir les rdv pour voir si le sujet correspond au contenu de la cellule
                For Each OlAppointment In OlFolder.Items
                    'si oui supprimé le rdv
                    If OlAppointment.Subject = c Then OlAppointment.Delete
                Next
            End If
        Next
    End With
    Set OlMapi = Nothing
    Set OlApp = Nothing
Avatar du membre
ric
Membre impliqué
Membre impliqué
Messages : 2'433
Appréciations reçues : 206
Inscrit le : 29 mai 2018
Version d'Excel : 365 fr 32 bits

Message par ric » 4 janvier 2019, 13:57

Bonjour,

L'erreur 13 est souvent associée une incompatibilité de type.
Sans fichier représentatif, c'est bien difficile à évaluer.
Essaie : If c.text <> "" Then > car, on parle du sujet.
Si pas de changement,
Essaie : If c.value <> "" Then

Sinon, un fichier anonymisé aiderait mieux.



ric
Un bon dépanneur : la touche F8 pour faire un Pas-à-Pas sur le code. :mrgreen:
K
Kompa01
Nouveau venu
Nouveau venu
Messages : 6
Inscrit le : 4 janvier 2019
Version d'Excel : 2016

Message par Kompa01 » 4 janvier 2019, 15:15

Bonjour Ric.

1000 merci pour le tips.
j'ai rajouté .text quand je copiais des textes et . value pour les chiffres et hop ça refonctionne.
une petit modifs par rapport au vieux excel apparement.
    
 '
 'supression des RDV qui ont la date de debut qui change
 '
 
    'Variables de fonctionnement
    Dim c As Range    'variable objet Range de la cellue en cours de boucle
    'nécéssite d'activer la référence Microsoft Outlook 16.0 Object Library
    Dim OlApp As New Outlook.Application    'déclaraction et création (New) de l'instance Outlook
    Dim OlMapi As Outlook.Namespace
    Dim OlFolder As Outlook.MAPIFolder
    Dim OlAppointment As Outlook.AppointmentItem
    'Initialisation des variables
    Set OlMapi = OlApp.GetNamespace("MAPI")
    Set OlFolder = OlMapi.GetDefaultFolder(olFolderCalendar)
    
    'Travail sur la feuille 'Calendrier'
    With Sheets("Calendrier")    'mettre le nom de la feuille en remplacement de Feuil1
        'Parcourir les cellules de la colonne A de la ligne 2 à la dernière ligne occupée
        For Each c In .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
            'Si la cellule n'est pas vide
            If c.Text <> "" Then
                'Parcourir les rdv pour voir si le sujet correspond au contenu de la cellule
                For Each OlAppointment In OlFolder.Items
                    'si oui supprimé le rdv
                    If OlAppointment.Subject = c.Text Then OlAppointment.Delete
                Next
            End If
        Next
    End With
    Set OlMapi = Nothing
    Set OlApp = Nothing
 ' Créer un RDV d'Outlook
  Set OutObj = CreateObject("outlook.application")
  ' Avec la feuille
  With Sheets("Calendrier")
    DLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne
    For Lig = 2 To DLig
        ' Importation du RDV
        DateRdv = CDate(Range("B" & Lig))
        Set OutAppt = OutObj.CreateItem(olAppointmentItem)
        With OutAppt
          .Subject = Sheets("Calendrier").Range("A" & Lig).Text
          .Location = Sheets("Calendrier").Range("D" & Lig).Text
          .Start = Sheets("Calendrier").Range("B" & Lig).Value
          .End = Sheets("Calendrier").Range("C" & Lig).Value
          .Duration = Sheets("Calendrier").Range("E" & Lig).Value
          .ReminderSet = False
          .Save
             End With
  Next Lig
  End With
  Set OutAppt = Nothing
Avatar du membre
ric
Membre impliqué
Membre impliqué
Messages : 2'433
Appréciations reçues : 206
Inscrit le : 29 mai 2018
Version d'Excel : 365 fr 32 bits

Message par ric » 4 janvier 2019, 19:22

Bonjour,

Bien heureux que ça fonctionne. :mrgreen:
'nécéssite d'activer la référence Microsoft Outlook 16.0 Object Library
Est-ce que tu sais qu'en déclarant correctement tous les objets nécessaires, tu peux te passer de l'activation de la référence à Microsoft Outlook....
L'avantage : le même fichier peut aisément être utilisé sur une version un peu plus ancienne et les versions nouvelles sans modification ?


ric
Un bon dépanneur : la touche F8 pour faire un Pas-à-Pas sur le code. :mrgreen:
K
Kompa01
Nouveau venu
Nouveau venu
Messages : 6
Inscrit le : 4 janvier 2019
Version d'Excel : 2016

Message par Kompa01 » 7 janvier 2019, 08:50

Bonjour Ric.

Désolé de ma réponse tardive.
non je ne sais pas du tout comment cela fonctionne.
Mais si tu sais comment faire je suis preneur :wink:

Jérôme
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message