Création/Suppression de RDV outlook via Excel
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
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
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
Bonjour,
Bien heureux que ça fonctionne.
'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
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
Jérôme