leoriviera
XLDnaute Nouveau
Bonjour,
Quand je lance ma macro pour envoyer un mail si le projet arrive à échéance, la macro ne marche pas et j'ai l'erreur suivante :
Erreur de compilation: Type défini par l'utilisateur non défini
Autre question est-il possible d'envoyé le mail automatiquement sans appuyer sur le bouton de commande ?
Merci
Sub Email()
Dim outlookDossier As Outlook.MAPIFolder
Dim outlookMessage As Outlook.MailItem
Dim VAdresse As String
Dim VObjet As String
Dim VMessage As String
Dim VCellule As Object
Dim Lig As Long
Dim DateRef
DateRef = DateAdd("d", 5, Date) ' date du jour +5jours
Lig = 2
Do While Cells(Lig, 1).Value <> ""
If Cells(Lig, 6).Value = "" Then
VMessage = ""
ProjetEnCours = Cells(Lig, 4).Value
VAdresse = Cells(Lig, 6).Value ' adresse du pilote
While ProjetEnCours = Cells(Lig, 4).Value ' On traite les lignes du projet
If Cells(Lig, 10).Value < DateRef Then ' date < date de référence
Cells(Lig, 7).Value = "Envoyé"
VMessage = VMessage & " La tâche :" & Cells(Lig, 4).Value _
& " à échéance prévue le " & Format(Cells(Lig, 10).Value, "DD/MM/YYYY") _
& " arrive à son terme. " & vbCrLf
End If
Lig = Lig + 1
Wend
If VMessage <> "" Then 'envoyer message si existe
VMessage = "Cher monsieur, madame," & vbCrLf & vbCrLf & VMessage
VMessage = VMessage & vbCrLf & "Cordialement"
VObjet = "Echeance projet " 'description
Set outlookDossier = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set outlookMessage = outlookDossier.Items.Add
With outlookMessage
.Subject = VObjet
.Recipients.Add VAdresse
.Body = VMessage
.OriginatorDeliveryReportRequested = True
.ReadReceiptRequested = True
.Send
End With
End If
Else
Lig = Lig + 1
End If
Loop
Set outlookMessage = Nothing
Set outlookDossier = Nothing
End Sub
Quand je lance ma macro pour envoyer un mail si le projet arrive à échéance, la macro ne marche pas et j'ai l'erreur suivante :
Erreur de compilation: Type défini par l'utilisateur non défini
Autre question est-il possible d'envoyé le mail automatiquement sans appuyer sur le bouton de commande ?
Merci
Sub Email()
Dim outlookDossier As Outlook.MAPIFolder
Dim outlookMessage As Outlook.MailItem
Dim VAdresse As String
Dim VObjet As String
Dim VMessage As String
Dim VCellule As Object
Dim Lig As Long
Dim DateRef
DateRef = DateAdd("d", 5, Date) ' date du jour +5jours
Lig = 2
Do While Cells(Lig, 1).Value <> ""
If Cells(Lig, 6).Value = "" Then
VMessage = ""
ProjetEnCours = Cells(Lig, 4).Value
VAdresse = Cells(Lig, 6).Value ' adresse du pilote
While ProjetEnCours = Cells(Lig, 4).Value ' On traite les lignes du projet
If Cells(Lig, 10).Value < DateRef Then ' date < date de référence
Cells(Lig, 7).Value = "Envoyé"
VMessage = VMessage & " La tâche :" & Cells(Lig, 4).Value _
& " à échéance prévue le " & Format(Cells(Lig, 10).Value, "DD/MM/YYYY") _
& " arrive à son terme. " & vbCrLf
End If
Lig = Lig + 1
Wend
If VMessage <> "" Then 'envoyer message si existe
VMessage = "Cher monsieur, madame," & vbCrLf & vbCrLf & VMessage
VMessage = VMessage & vbCrLf & "Cordialement"
VObjet = "Echeance projet " 'description
Set outlookDossier = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set outlookMessage = outlookDossier.Items.Add
With outlookMessage
.Subject = VObjet
.Recipients.Add VAdresse
.Body = VMessage
.OriginatorDeliveryReportRequested = True
.ReadReceiptRequested = True
.Send
End With
End If
Else
Lig = Lig + 1
End If
Loop
Set outlookMessage = Nothing
Set outlookDossier = Nothing
End Sub