macro excel mail

[faguer]

Bonjour je n'arrive pas à modifier ma macro afin quel aille chercher une adresse mail dans une cellule du fichier ouvert

merci pour votre aide



'envoie par mail
' suppession de l'information des ligne restante à commander
Range("i6").Select
Selection.ClearContents
'Fonctionne sous excel 2000-2013
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim S As Shape
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
'Copie la feuille active comme nouvelle feuille
ActiveSheet.Copy
Set destwb = ActiveWorkbook
'Désactiver fenêtre de compatibilité
Application.DisplayAlerts = False
'----------------------------------------------------------------------------
'Sauvegarde la nouvelle feuille/L'envoie par mail/La supprime
'----------------------------------------------------------------------------
TempFilePath = Environ$("temp") & "\"
TempFileName = ActiveSheet.Name
Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)
With destwb
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFilePath & TempFileName & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False ' sauvegarde du fichier au format pdf
On Error Resume Next



.To = "bfaguer@ghef.fr"

Je voudrais que cette adresse change celons l'adresse qui est dans la cellule A1


.CC = ""
.bcc = ""
.Subject = "DEMANDE DE FOURNITURES ET D'EQUIPEMENTS HORS MAGASINS"
.Attachments.Add TempFilePath & TempFileName & ".pdf"
.Body = "Bonjour, Vous trouverez ci joint notre commande merci de nous informer de son envoie à notre fournisseur de nous communiquer le numéro de commande ainsi que toute modification à effectuer pour la prochaine commande Cordialement (voici une proposition de texte) ( Le programme pour les commandes classe 6 est opérationnel merci de voir quand est ce que l'on peut ce voir pour la présentation et les modifications que vous souhaitez) "
'.display 'ou alors utiliser
.Send 'pour envoi
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
'Effacer le fichier envoyé
Kill TempFilePath & TempFileName & ".pdf"

Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With

 

[Lone-wolf]

Bonjour faguer et bienvenue sur XLD , le Forum

Dim AdrMail As String

AdrMail = Feuil2.Range("a1").Value

.To = AdrMail

 

[Dydou76]

bonjour,
j'ai un code pour envoyer une feuille de mon classeur en mail je met Cc = "adresse email"
cette adresse est dans une cellule. Mon souci c'est que cette adresse mail ne copie dans la ligne "sujet" de outlook plutot que de se mettre dans en CC...
je ne vois pas ou est l'erreur. Pouvez vous m'aider ? voisi mon code.
Merci d'avance

With Sheets("base")

Dim MailAd As String
Dim Msg As String
Dim Subj As String
Dim URLto As String, CC As String
MailAd = .Range("I2") 'broddenis@hotmail.com
Subj = .Range("J2") 'Objet Fiche Agir
Msg = .Range("K2") 'Veuillez trouver ci-joint la Fiche Agir
CC = .Range("I3")
URLto = "mailto:" & MailAd & "?subject=" & Subj & "Fiche Agir" & CC & "&body=" & Msg
ActiveWorkbook.FollowHyperlink Address:=URLto


End With