Envois par mail

[Luinil]

Bonjours a tous et a toutes.
J'ai été combler par ma réponse reçus se matin pour un autre problème et reviens donc en force, avec une nouvelle question!

Tout d'abords, merci a ceux qui se pencheront sur mon problème!

J'utilise un code qui copie sans macro, sans objet une feuille de ma base de donné vers un nouveau classeur. Celui-ci l'enregistre sous le nom EnvoisEmail.xls toujours dans le même dossier (il supprime l'ancien et laisse place au nouveau).

Quand cela est fait, et c'est la que je bug, j'ai utilisé l'enregistreur de macro pour transformer une case en liens email puis simuler un clic dessus (se qui m'ouvre, dans mon cas, outlook express )
Voici le code:

    Range("D7:I7").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        "mailto:Lui@hotmail.com?subject=Votre fiche de personnage", TextToDisplay:= _
        "Lui@hotmail.com"
    Range("D7:I7").Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True

Seulement voila, peux importe se qui est marquer dans la case D7:I7, il met le liens Lui@hotmail.com (Au lieu de l'adresse qui y est déjà marquer). Comment remédiez a cela ?

Deuxième question:
Cette technique ouvre l'engin par défaut d'excel (Se que je souhaite, car la base de donné peux changer d'ordinateur), elle y insère l'adresse du liens et le titre : Votre fiche de personnage.
Y inséré un message automatiquement est t'il réalisable avec ma technique ?
Y inséré la pièce jointe EnvoisEmail.xls est t'il réalisable avec ma technique ?

Merci d'avance a tous ceux qui prendront un peu de leur temps pour m'aider!
Luinil

 

[Guest]

Re : Envois par mail

bonsoir Luinil,

La réponse est par là ce me semble.

Bonne recherche.

 

[Luinil]

Re : Envois par mail

Bonjour Hasco.
Aucun titre de sujet ne correspond a l'envoi par mail via macro dans la section que tu m'as envoyer lire.

Dois-je ouvrir chacun d'eux pour chercher dans chaqu'un d'eux ?
Luinil

 

[Guest]

Re : Envois par mail

Re,

Eh oui la vie est dure!

Parce que je suis gentil, voici un début https://www.excel-downloads.com/thr...oter-dautres-applications-depuis-excel.92359/

Cherche sur cette page. Sinon tu as le moteur de recherche du forum(En haut dans une bande bleue horizontale)

A+

 

[Cousinhub]

Re : Envois par mail

Bonsoir, Hasco


Tu fais pas d'effort, non plus.......

alors que lui,.......

OK, je sors

 

[Guest]

Re : Envois par mail

Hello bh²

faut ben aller manger....!...un ti peu....

A++

 

[Luinil]

Re : Envois par mail

Rebonjour,

J'ai été lire votre document, il semble qu'il soit impossible de joindre automatiquement un fichier avec outlook express. (possible uniquement avec Outlook)
Tant pis.

Mais cela ne résous pas mon premier probleme. J'ai donc essayer avec cette formule:

    Sub envoiMailOE()

    Dim Adresse As String

    Dim Sujet As String, Texte As String

    Adresse = "Mon_Adresse@hotmail.com"

    Sujet = "Test d'envoi "

    Texte = "Bonjour ," & vbCrLf & vbCrLf & "Voici une copie de votre fiche de personnage. Celle-ci est la plus récente que nous avons en notre possession. " & vbCrLf & vbCrLf & "Signé " & Application.UserName

    Shell "C:\Program Files\Outlook Express\msimn.exe " & "/mailurl:mailto:" & Adresse & "?subject=" & Sujet & "&Body=" & Texte

    End Sub

Le bouton ne bug pas, il ne fait tout simplement rien, mon adresse est pourtant bonne mais je ne ressois pas de mail.

Je dois aussi pouvoir mettre l'adresse qui se trouve en case D7:I7 comme destinataire:
Adresse = "D7:I7"
Et faire en sorte qu'il ne send pas le message pour que je puisse attacher manuellement le fichier.

Merci d'avance.
Luinil

 

[Guest]

Re : Envois par mail

Re Bonsoir,

Chez moi cette procédure fonctionne:

Ouverture de Outlook Express avec le sujet et le texte.
Il ne te reste plus qu'à insérer manuellement le fichier.

quant à D17:I17 j'ai supposé, puisque tu ne le dis pas qu'il n'y avait qu'une adresse en D17.

Si ça n'ouvre pas outlook express, il faut vérifier le chemin vers OE.

Sub envoiMailOE()
    Dim Adresse As String
    Dim Sujet As String, Texte As String
    Adresse = Range("D17").Text
    Sujet = "Test d'envoi "
    Texte = "Bonjour ," & vbCrLf & vbCrLf & "Voici une copie de votre fiche de personnage. Celle-ci est la plus récente que nous avons en notre possession. " & vbCrLf & vbCrLf & "Signé " & Application.UserName
    Shell "C:\Program Files\Outlook Express\msimn.exe " & "/mailurl:mailto:" & Adresse & "?subject=" & Sujet & "&Body=" & Texte
End Sub

A+

 

[noviceAG]

Re : Envois par mail

Bonsoir Jean-Marcel, Luinil, Hasco, bhbh, le Forum,

Un peu de lecture pour meubler la soirée

sorti de mes archives

Pour les lignes
Code:
COPIE = Right(COPIE, Len(COPIE) - 1)
DESTI = Right(DESTI, Len(DESTI) - 1)Elles sont inutiles dans la mesure où outlook enlèves tout seul comme un grand les séparateurs en trop mais pour les éditeurs de messagerie qui n'ont pas cette faculté, c'est interessant.

Concernant mon problème, j'ai finalement trouvé la solution (avec cerise sur le gateau l'intégration de la propriété italique)
J'ai utilisé une variable MISENFORM qui représente la somme de :
GRAS (200 si bold=true ou 100 si bold=false),
ITAL(20 si italic=true ou 20 si italic=false)
et SOUL (2 si souligné, 1 si non)
Ensuite j'affecte en fonction des 8 possibilités une valeur pour MISENFORM1 (ouverture des balises :<b> si gras,<i> si italic, <u> si souligné) et MISENFORM2 (fermeture des balises : </b>, </i> et </u>)
Restait ensuite à intégrer MISENFORM1 et MISENFORM2 dans la variable CORPS.
J'ai également intégré une condition si la cellule est vide, dans ce cas on ajoute à CORPS, la balise <br> permettant un renvoi à la ligne.

Au final, le code suivant fonctionne parfaitement :

Code:
For i = 2 To lig 'boucle définissant le corps du message et son format du coprs du message par des balises HTML
With Sheets("email").Cells(i, 2)
If .Value <> "" Then
If .Font.Bold = True Then GRAS = 200 Else GRAS = 100
If .Font.Italic = True Then ITAL = 20 Else ITAL = 10
If .Font.Underline = xlUnderlineStyleSingle Then SOUL = 2 Else SOUL = 1
MISENFORM = GRAS + ITAL + SOUL
Select Case MISENFORM
Case 222
MISENFORM1 = "<b><i><u>": MISENFORM2 = "</b></i></u>"
Case 212
MISENFORM1 = "<b><u>": MISENFORM2 = "</b></u>"
Case 221
MISENFORM1 = "<b><i>": MISENFORM2 = "</b></i>"
Case 211
MISENFORM1 = "<b>": MISENFORM2 = "</b>"
Case 122
MISENFORM1 = "<i><u>": MISENFORM2 = "</i></u>"
Case 121
MISENFORM1 = "<i>": MISENFORM2 = "</i>"
Case 112
MISENFORM1 = "<u>": MISENFORM2 = "</u>"
Case 111
MISENFORM1 = "": MISENFORM2 = ""
End Select
CORPS = CORPS & MISENFORM1
CORPS = CORPS & "<br><font style='font-family: "
CORPS = CORPS & .Font.Name
CORPS = CORPS & ";font-size: " & .Font.Size
CORPS = CORPS & "pt ;' color=" & GetRGB(.Font.Color)
CORPS = CORPS & ">" & .Value
CORPS = CORPS & "</font>" & MISENFORM2
Else: CORPS = CORPS & "<br>"
End If
End Withci-joint fichier avec la correction.


'Ce code est créer par Birama Diop - Pour toute question vous pouver m'écrire un mail sur :
'diopbirama@gmail.com

Private Sub cmdCopier_Click()
If txtFeuilChoisi.Text <> "" Then
Call CopierFeuilleExcel(getTemp & "test.xls")
Else
MsgBox ("Veuillez choisir la feuille a copier")
End If
If ((getTemp & "test.xls") = ActiveWorkbook.FullName) Then
cmdCopier.Enabled = False
cmdEnvoyer.Enabled = True
Else
cmdCopier.Enabled = True
End If
End Sub

'Private classeurDeBase As Excel.Workbook
Private Sub cmdEnvoyer_Click()
ActiveWorkbook.SendMail Recipients:="diopbirama@gmail.com", _
Subject:="Test envoi classeur", _
ReturnReceipt:=True
' URLto = "mailto:diopbirama@gmail.com" & "?subject=test d'envoi de fichier" & "&body=" & Msg
' ActiveWorkbook.FollowHyperlink Address:=URLto
End Sub

Private Sub cmdExit_Click()
Unload Me
End Sub

Private Sub combFeuilleSource_Change()
txtFeuilChoisi.Text = combFeuilleSource.Text
End Sub

'c'est ici que je récupere la liste des feuilles du classeur actif (Activeworkbooks)

Private Sub UserForm_Activate()
Dim feuil As Object
For Each feuil In ActiveWorkbook.Sheets
combFeuilleSource.AddItem (feuil.Name)
Next feuil
'classeurDeBase = ActiveWorkbook
If ((getTemp & "test.xls") = ActiveWorkbook.FullName) Then
cmdCopier.Enabled = False
cmdEnvoyer.Enabled = True
Else
cmdCopier.Enabled = True
End If
End Sub

'cette procedure permet de copier la feuille choisie vers le classeur cible du dossier Temp

Private Sub CopierFeuilleExcel(ClasseurCible As String)
Sheets(txtFeuilChoisi.Text).Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs (ClasseurCible)
Application.DisplayAlerts = True
End Sub

'cette fonction permet de récuper le répertoire temporaire de windows

Function getTemp() As String
Dim chemin As Object
Dim DossierTemp As String
Set chemin = CreateObject("Scripting.FileSystemObject")
DossierTemp = chemin.GetSpecialFolder(TemporaryFolder).ShortPath
getTemp = DossierTemp & "\Temp\"
End Function

Bonne soirée

 

[Luinil]

Re : Envois par mail

A Jean Marcel:
La procédure a échouer dans sa tentative de connexion au serveur.
Le problème viens de cette ligne, mais que mettre a la place ?
.Item(CdoConfiguration.cdoSMTPServer) = "L'adresse du serveur"

A Hasco:
Merci, ta technique marche, mais comme elle n'est pas capable d'ajouter une pièce jointe, je la garde en deuxième recours

A noviceAG:
Je suis encore qu'un débutant et je n'ai compris a ton code ^^

Dans tous les cas, merci a vous tous
Luinil

 

[Luinil]

Re : Envois par mail

Une idée pour arranger la formule de Jean-Marcel qui semble parfaite ?

 

[Luinil]

Re : Envois par mail

Je viens de découvrir la fonction envoyer vers (disponible a partir du menu fichier).

Cela envois au destinataire la feuil active du classeur directement dans le corps du message. C'est se qui serait vraiment le mieux pour moi.

Le problème étant que l'enregistreur macro ne fonctionne pas , il stop d'enregistrer des que je clique sur menu fichier ou que je sélectionne l'envoies du message.

Avez vous une idée ?

Edit1:

   Dim Adresse As String
    Dim Sujet As String, Texte As String
    Adresse = Range("D7").Text
    Sujet = "Votre fiche de personnage "
    Texte = "Bonjour ," & vbCrLf & vbCrLf & "Voici une copie de votre fiche de personnage. Celle-ci est la plus récente que nous avons en notre possession. " & vbCrLf & vbCrLf & "Si vous avez des commentaires ou pour tout mise à jour, vous n'avez qu'à répondre à se mail." & vbCrLf & vbCrLf & "Votre équipe de mise à Jour." & vbCrLf & vbCrLf & Range("A1:V85").Text
      Shell "C:\Program Files\Outlook Express\msimn.exe " & "/mailurl:mailto:" & Adresse & "?subject=" & Sujet & "&Body=" & Texte

Se n'est que le & Range("A1:V85").Text qui ne fonctionne pas.

 

[Luinil]

Re : Envois par mail

Bonjour, et merci encore une fois!
Quelques questions:

Microsoft CDO for windows 2000 library
Je ne l'ai pas dans ma liste, celui qui s'en rapproche le plus étant:
Microsoft CDO for exchange 2000 library

Ensuite, si j'ai bien compris:
.Item(CdoConfiguration.cdoSendUserName) = "Riri.Lolo" 'Mettre ici ton identilfiant
.Item(CdoConfiguration.cdoSendPassword) = "Titi" ' Mettre ici ton mot de passe de messagerie
.Item(CdoConfiguration.cdoSMTPServer) = "smtp.orange.fr" '(exemple:"Smtp.orange.fr")
Si j'utilise exemple hotmail, je met smtp.hotmail.com ?

Merci pour l'aide et le temps que vous m'accorder, cela est très apprécié!
Luinil

 

[jeanpierre]

Re : Envois par mail

Bonsoir le fil, Luinil,

Pour te dire et simplement, Renseigne ton Pseudo de ta version d'Excel, ce qui évitera, souvent, des réponses inadaptées.

Important de connaître la version.

Bonne soirée.

Jean-Pierre

 

[Luinil]

Re : Envois par mail

Pardon pour la version :S
Excel 2002 sur mon poste
Mais tous sa doit être compatible avec d'autre version, car le programme est appellé a être installé sur plusieurs ordinateur.

Je commence a croire que joindre le fichier a la main et faire send sera la meilleur solution pour moi.
Dans tout les cas, merci pour tout
Luinil