ENVOI D'UN COURRIEL PAR SMTP
econs
Messages postés
4030
Date d'inscription
mardi 13 mai 2003
Statut
Membre
Dernière intervention
23 décembre 2008
-
16 juin 2006 à 16:44
cs_pierrot01 Messages postés 13 Date d'inscription lundi 2 juin 2003 Statut Membre Dernière intervention 9 novembre 2009 - 8 avril 2009 à 14:11
cs_pierrot01 Messages postés 13 Date d'inscription lundi 2 juin 2003 Statut Membre Dernière intervention 9 novembre 2009 - 8 avril 2009 à 14:11
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/38084-envoi-d-un-courriel-par-smtp
https://codes-sources.commentcamarche.net/source/38084-envoi-d-un-courriel-par-smtp
8 avril 2009 à 14:11
Pour envoyer une pice jointe, j'ai bien inserer le code que tu as donné apres :
MyMessage = "DATE: " & Format$(Now, "dd/mm/yy ttttt") & _
vbCrLf & "FROM: <" & txtEmailOrigine.Text & ">" & vbCrLf & _
"TO: <" & txtDestinataire & ">" & vbCrLf & _
"SUBJECT: " & txtObjet.Text & vbCrLf & vbCrLf & _
txtMessage.Text & vbCrLf & "." & vbCrLf & vbCrLf
'Ajout de code pour piece jointe
SMTP_INDEX = 1
SMTP_Attachment = "c:\pj.txt"
..........................
.............................
mais, ca fonctionne pas.
@+
13 févr. 2007 à 09:56
Merci de cette réponse rapide. Je viens juste d'essayer, il y a un petit pb dans le code, la fonction InStrRev n'existe pas. Je l'ai écrit comme ca :
Function InStrRev(PF As String, Sep As String)
Dim Lg As Integer, Car As String
Lg = Len(PF)
Do While Lg >= 1
Car = Mid(PF, Lg)
If Car = Sep Then
Exit Do
End If
Lg = Lg - 1
Loop
InStrRev = Lg
End Function
Apparement ca marche pour cette fonction. Par contre j'ai un problème "outlook" supprime ma pièce jointe car jugé non fiable.
Que vient faire "outlook" la dedans ? Quel moyen pour contourner cette erreur ?
Merci d'avance.
PS : je suis en vb5, lors de la fermeture du programme vb ne répondait plus. Pour remédier à cette erreur j'ai juste ajouté le numéro de fichier après l'instruction close qui concerne le fichierEML :
Open FichierEML For Output As #frf
Print #frf, MyMessage
Close #frf
12 févr. 2007 à 15:06
Je tiens a répondre à ma question plusieurs destinataire :)
Winsock1.SendData "RCPT TO: <JCDuss@bronze.fr>" & vbCrLf
Winsock1.SendData "RCPT TO: " & vbCrLf
Il ne faut pas oublier de préciser ces infos également dans la partie du code retour 354
FROM: <sender@..>
TO: <recipient1>
TO: <recipient2>
.....
Je tiens également à préciser que pour mettre une personne en CC d'un mail
Winsock1.SendData "RCPT CC: " & vbCrLf ne FONCTIONNE PAS
Il faut le mettre en Winsock1.SendData "RCPT TO: " & vbCrLf
et dans le code retour 354
TO: <JCDuss@bronze.fr>" & vbCrLf
CC: " & vbCrLf
Nico
12 févr. 2007 à 14:59
Oui c'est possible, il te faudra par contre toujours convertir ton fichier à l'aide du code suivante
'dans l'event Winsock1_DataArrival tu dois ajouter le code suivant juste après le code permettant d'ajouter le sujet du mail.
SMTP_Index = 1
If SMTP_Attachment <> "" Then
For i = 1 To Len(SMTP_Attachment)
If Mid(SMTP_Attachment, i, 1) = "," Then
If Dir(Mid(SMTP_Attachment, SMTP_Index, i - SMTP_Index)) = "" Then
SMTP_Report = SMTP_Report & " - File : " & Mid(SMTP_Attachment, SMTP_Index, i - SMTP_Index) & " is not found" & vbCrLf
Else
MyMessage = MyMessage & UUEncodeFile(Mid(SMTP_Attachment, SMTP_Index, i - SMTP_Index))
End If
SMTP_Index = i + 1
End If
Next i
If Dir(Mid(SMTP_Attachment, SMTP_Index, Len(SMTP_Attachment))) = "" Then
SMTP_Report = SMTP_Report & " - File : " & Mid(SMTP_Attachment, SMTP_Index, Len(SMTP_Attachment)) & " is not found" & vbCrLf
Else
MyMessage = MyMessage & UUEncodeFile(Mid(SMTP_Attachment, SMTP_Index, Len(SMTP_Attachment)))
End If
End If
**********
Public Function UUEncodeFile(strFilePath As String) As String
Dim intFile As Integer 'le numéro de fichier pour Open()
Dim intTempFile As Integer 'idem pour le fichier temporaire
Dim lFileSize As Long 'taille du fichier
Dim strFileName As String 'nom du fichier
Dim strFileData As String 'le tampon pour l'encodage
Dim lEncodedLines As Long 'nombre de lignes traitées
Dim strTempLine As String 'un autre tampon
Dim i As Long 'compteur i
Dim j As Integer 'compteur j
Dim strResult As String
'
'On extrait le nom du fichier du chemin
strFileName = Mid$(strFilePath, InStrRev(strFilePath, "") + 1)
'
'On insère l'en-tête du fichier attaché: "begin 664 ..."
strResult = "begin 664 " + strFileName + vbLf
'
'on trouve la taille du fichier
lFileSize = FileLen(strFilePath)
lEncodedLines = lFileSize \ 45 + 1
'Les données sont encodées par morceaux de 45 octets,
'on initialise donc le buffer à "45 blancs"
strFileData = Space(45)
intFile = FreeFile
Open strFilePath For Binary As intFile
For i = 1 To lEncodedLines
'On lit le contenu du fichier par morceaux de 45 octets
'
If i = lEncodedLines Then 'si on est à la fin du fichier
'Quand on atteint la fin du fichier, en général
'il reste moins de 45 octets à traiter, on adapte
'donc la taille du tampon
strFileData = Space(lFileSize Mod 45)
End If
'On copie les 45 octets en memoire
Get intFile, , strFileData
'Le premier symbole de la chaîne contient l'info
'sur la quantité de symboles dans la chaîne encodée
strTempLine = Chr(Len(strFileData) + 32)
'
If i = lEncodedLines And (Len(strFileData) Mod 3) Then
'Si c'est la dernière ligne qui est traitée et
'la longueur n'est pas divisible par 3,
'on rajoute 2 ou 3 blancs
strFileData = strFileData + Space(3 - _
(Len(strFileData) Mod 3))
End If
For j = 1 To Len(strFileData) Step 3
'On transforme 3x8 bits en 4x6 bits
'
'1er octet
strTempLine = strTempLine + _
Chr(Asc(Mid(strFileData, j, 1)) \ 4 + 32)
'2e octet
strTempLine = strTempLine + _
Chr((Asc(Mid(strFileData, j, 1)) Mod 4) * 16 _
+ Asc(Mid(strFileData, j + 1, 1)) \ 16 + 32)
'3e octet
strTempLine = strTempLine + _
Chr((Asc(Mid(strFileData, j + 1, 1)) Mod 16) * 4 _
+ Asc(Mid(strFileData, j + 2, 1)) \ 64 + 32)
'4e octet
strTempLine = strTempLine + _
Chr(Asc(Mid(strFileData, j + 2, 1)) Mod 64 + 32)
Next j
'rajouter le code traité au résultat
strResult = strResult + strTempLine + vbLf
'réinitialiser le tampon
strTempLine = ""
Next i
Close intFile
'on rajoute le marqueur de fin
strResult = strResult & "'" & vbLf + "end" + vbLf
'on renvoie la chaîne de caractères
UUEncodeFile = strResult
End Function
*****
Nico
12 févr. 2007 à 14:50
Juste une petite question :
Peut on envoyer une pièce jointe avec cette méthode ?
Je cherche juste à transférer une base de données qui ce trouve sur un PC distant vers un serveur, le PC distant n'est pas sur le réseau local (ni LAN, ni WAN)il ne posséde qu'un acces internet avec modem 56k. La base de données est gérée par un programme en vb, il me parrait donc assez simple que l'utilisateur envoi un mél pour sauvegarder sa base à condition qu'il n'est à cliquer que sur un bouton, d'ou l'interet de ce code si l'envoi d'une pièce jointe est possible.
Merci.
Fantimat
7 févr. 2007 à 12:00
Je trouve ce bout de code excellent car contrairement à d'autre source SMTP winsock : ca marche du premier coup. Par contre, c'est quoi l'astuce pour envoyer à plusieurs destinataires ???
J'ai essayé les séparateur ";" & "," mais sans succès
merci d'avance
Nico
16 juin 2006 à 17:54
On peut faire mieux, par exemple ajouter une signature, un timing de déconnection, etc ...
email_serveur_envoi=smtp.serveur.fr
email_nom_expediteur=BB
email_adresse_expediteur=bernard-beville@wanadoo.fr
Dans la version actuelle, je fais d'abord une vérif de la connexion, puis une vérif des codes, et enfn j'envoie le message.
BB
16 juin 2006 à 16:44
# frf = FreeFile
# EMailValide = True
# On Error GoTo sortie
# Open Fichier For Input As #frf
Et où est donc le fichier ConfigMail.txt ?
Autre point, mets toujours ton FreeFile juste avant le Open. Si tu places plein d'instructions entre les deux commandes, du temps peut s'écouler, et le FreeFile désigné pourrait très bien ne plus être disponible ...