TstNet permet d'envoyer un mail si connection existe
sinon un code d'erreur vous dit que vous n'êtes pas connecté
on peut aussi lancer la messagerie par défaut
ou /et appeler un site
les 2 autres fichiers ( ne sont pas de moi )
MsTools est un AddIn pour VB trés bien
IndenterVB5.exe est un AddIn pour VB trés bien
salut à tous
Source / Exemple :
Option Explicit
'La suite se trouve dans le ZIP dont le module mTestNet.bas
Dim NomUtilisateur$
Dim NomServeurSMTP$
Dim MotDePasse$
Dim AdressDestinataire$
Dim AdressExpediteur$
Dim AdressCopy$
Dim HommeInvisible$
Dim PieceJointe$
Dim Message$
Dim TypeConnect$
'============================
Private Sub cmdSiteJpf_Click()
'---------------------------------------------------------------------------------------
' Procedure : cmdSiteJpf_Click
' DateTime : 28/08/2004 11:28
' Author : jean-paul
' Purpose :
'---------------------------------------------------------------------------------------
Dim Foo As String
Dim bconnecter_net As Boolean
Dim iRc%
iRc = ComposemailTest
'if irc=1 thern 1 message envoye
'if irc=2 thern 1 message envoye mais pas trouvé la piece à joindre
If iRc < 0 Then
MsgBox "Vous n'avez pas de connection permanente Internet"
TypeConnect = ""
End
Else
MsgBox " Votre Connection Internet est active "
TypeConnect = "PERMANENT"
Foo = ShellExecute(hWnd, "Open", "http://perso.wanadoo.fr/jean-paul.faidherbe", "", "", 1)
End If
End Sub
'===========================
Private Function ComposemailTest() As Integer
'---------------------------------------------------------------------------------------
' Procedure : ComposemailTest
' DateTime : 28/08/2004 10:46
' Author : jean-paul
' Purpose :tente l'envoi d'un email pour savoir si connection Internet valide
'---------------------------------------------------------------------------------------
Dim A(10) As String
Dim Rc%, I%
Dim Fichier As String
Dim dummy As String
Dim LigneMessage$
Dim strMessage$
Dim MyFile As String
Dim iMsg As New CDO.Message
Dim iConfig As New CDO.Configuration
Dim Champs As ADODB.Fields
Set Champs = iConfig.Fields
With Champs
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = NomServeurSMTP '"smtp.wanadoo.fr"
.Item(cdoSMTPConnectionTimeout) = 10
.Item(cdoSMTPAuthenticate) = cdoBasic
.Item(cdoSendUserName) = NomUtilisateur
.Item(cdoSendPassword) = MotDePasse ' "jp050738"
.Item(cdoURLProxyServer) = "server:80"
.Item(cdoURLProxyBypass) = "<local>"
.Item(cdoURLGetLatestVersion) = True
End With
' Maintenant le message lui meme
With iMsg
Set .Configuration = iConfig
.To = AdressDestinataire
.From = AdressExpediteur ' "jean-paul.faidherbe@wanadoo.fr"
.Subject = App.EXEName & "_" & PieceJointe & "_" & Format(Now, "dd/mm/yyyy")
ENVOI:
' ajouter les infos diverses
strMessage = strMessage & "DE_: " & AdressExpediteur & vbCrLf
strMessage = strMessage & "A__ : " & AdressDestinataire & vbCrLf
strMessage = strMessage & "CC_:" & AdressCopy & vbCrLf
strMessage = strMessage & "CCI:" & HommeInvisible & vbCrLf
.TextBody = strMessage
On Error GoTo ERR_CDO
'------------------------------ENVOYER tous les ZIP de CheminExport
MyFile = Dir(App.Path & "\*.bas", vbNormal)
Do While MyFile <> "" ' Commence la boucle.
.AddAttachment App.Path & "\" & MyFile
MyFile = Dir
Loop
' Call AfficheMsg("Envoi du Mail en cours ", -1)
On Error GoTo ERR_CDO
' send sans parametre FALSE on peut mettre true
.Send
End With
' quand on arrive ici est-ce envoyé ????????
ComposemailTest = 1
Exit Function
'' quand on arrive ici c'est pas encore envoyé
ERR_CDO:
If Err.Number = -2147024891 Then ' cdoE_NO_ACCESS hex( -2147024891 )=80070005
Resume Next ' attendre
ElseIf Err.Number = -2147220973 Then ' hex( -2147220973)=8004 0213 ou 1531
Message = Err.Description & " " & "pas de connection valide"
MsgBox Message, vbCritical
ComposemailTest = -1
Exit Function
Else
MsgBox Err.Number & vbCrLf & Err.Description
ComposemailTest = -1
End If
Exit Function
PasDeFichier:
MsgBox App.Path & "Pas de Fichier !!!" & Fichier, vbCritical
ComposemailTest = 2
Exit Function
End Function
'=============================
Public Sub VBHref(strURL As String)
'=============================
Dim Foo As String
Foo = ShellExecute(hWnd, "Open", strURL, "", "", 1)
End Sub
'==========================
Private Sub cmdMail_Click()
'==========================
VBHref "mailto:" & AdressDestinataire & "?subject=" & PieceJointe
End Sub
Private Sub cmdFermer_Click()
End
End Sub
'==========================
Private Sub Form_Load()
'==========================
' login du compte chez la FAI NomUtilisateur="fti/abcde6k"
' MotDePasse "*******"
' smtp.wanadoo.fr NomServeurSMTP
' jean.toto@wanadoo.fr adresse du destinataire
' jules.butte@wanadoo.fr adresse expediteur
NomUtilisateur = "fti/xxxxxxk"
NomServeurSMTP = "smtp.wanadoo.fr"
MotDePasse = "mmmmmm"
AdressDestinataire = "jipef@wanadoo.fr"
AdressExpediteur = "jipef@wanadoo.fr"
AdressCopy = AdressDestinataire ' "moi@wanadoo.fr"
HommeInvisible = AdressDestinataire ' "moncopain@wanadoo.fr"
PieceJointe = App.Path & "\mTestNet.bas"
End Sub
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.