Je monte actuellement une petite application de rédaction d'un mail automatique avec outlook.
Je dois donc récupérer plusieurs adresses mails destinataire sur la feuille "GENERAL".
Le programme fonctionne tant que que la feuille en question est la feuille active.
Si la feuille active (par exemple la feuille "test") est active, les adresses ne sont plus recherchées alors que j'ai imposé l'utilisation de la feuille "GENERAL".
Je ne peux pas joindre de fichier car il dépasse 293 ko mais voici le code utilisé.
Sub ENVOI_SYN()
' Création de l'e-mail d'envoi
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim tableauDestinataires() As String
Dim nbDestinataires As Integer
nbDestinataires = 0
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
' Recherche des destinataires
With Sheets("GENERAL")
On Error Resume Next
For Each cell In Columns("D").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "I").Value) = "@" Then
ReDim Preserve tableauDestinataires(nbDestinataires)
tableauDestinataires(nbDestinataires) = cell.Value
nbDestinataires = nbDestinataires + 1
End If
Next cell
End With
' Création de l'e_mail
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = tableauDestinataires
.Subject = Sheets("GENERAL").Range("B8") & " - " & Sheets("GENERAL").Range("B9") & " - " & Sheets("GENERAL").Range("B10") & " - TEKTO ING - TRANSMISSION DE DOCUMENTS D'EXECUTION - POUR SYNTHESE"
.Body = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint :"
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Merci pour les tuyaux .
Je dois donc récupérer plusieurs adresses mails destinataire sur la feuille "GENERAL".
Le programme fonctionne tant que que la feuille en question est la feuille active.
Si la feuille active (par exemple la feuille "test") est active, les adresses ne sont plus recherchées alors que j'ai imposé l'utilisation de la feuille "GENERAL".
Je ne peux pas joindre de fichier car il dépasse 293 ko mais voici le code utilisé.
Sub ENVOI_SYN()
' Création de l'e-mail d'envoi
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim tableauDestinataires() As String
Dim nbDestinataires As Integer
nbDestinataires = 0
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
' Recherche des destinataires
With Sheets("GENERAL")
On Error Resume Next
For Each cell In Columns("D").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "I").Value) = "@" Then
ReDim Preserve tableauDestinataires(nbDestinataires)
tableauDestinataires(nbDestinataires) = cell.Value
nbDestinataires = nbDestinataires + 1
End If
Next cell
End With
' Création de l'e_mail
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = tableauDestinataires
.Subject = Sheets("GENERAL").Range("B8") & " - " & Sheets("GENERAL").Range("B9") & " - " & Sheets("GENERAL").Range("B10") & " - TEKTO ING - TRANSMISSION DE DOCUMENTS D'EXECUTION - POUR SYNTHESE"
.Body = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint :"
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Merci pour les tuyaux .