Changement d'adresse SMTP sur Outlook express

Voilà une macro Excel qui permet de faire ça en automatique.
Dans les paramètres Outlook il faut mettre comme serveur SMPT:
currentsmtp
Il faut AU MOINS UNE FOIS aller dans tes paramètres réseau dans WINS faire importer fichiers LMHOST. Tu importes celui par défaut de Windows.
Si tu utilises OUTLOOK et pas Outlook Express, tu peux mettre ce code dans ThisOutlookSession et ajouter:
Private Sub Application_Startup()
Call GetIPSMTP
End Sub

Sinon, voilà le code:

Option Explicit
Public MonIPPublic As String, MonSMTP As String

Public Sub GetIPSMTP()
Dim wnh As Object, IPPublic As String, DebRep As Long, FinRep As Long, i As Integer
Dim fs, f, TxtLigne As String, MonIPSMTP As String, CherchePoint1 As Integer, CherchePoint2 As Integer
Dim DebIPSmtp As Long, FinIPSmtp As Long, DomFai As String, UrlTest As String
On Error GoTo TraiteErreur
Set wnh = CreateObject("WinHttp.WinHttpRequest.5.1")
IPPublic = ""
GoSub OuvreUrl1
MonIPPublic = Mid$(IPPublic, DebRep, FinRep - DebRep)
Shell Environ$("comspec") & " /c tracert -h 1 -w 1 " & MonIPPublic & " >""c:\SMTP.txt"""
TxtLigne = "": i = 0
While CmdActif = True And i < 1000
i = i + 1
Wend
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile("c:\SMTP.txt", ForReading, False)
Do While f.AtEndOfStream <> True
TxtLigne = f.ReadLine
If InStr(1, TxtLigne, MonIPPublic) > 0 Then
CherchePoint1 = InStr(1, TxtLigne, MonIPPublic)
CherchePoint1 = InStrRev(TxtLigne, ".", CherchePoint1)
CherchePoint2 = InStrRev(TxtLigne, ".", CherchePoint1 - 1) + 1
DomFai = Trim(Mid$(TxtLigne, CherchePoint2, CherchePoint1 + 4 - CherchePoint2))
Exit Do
End If
Loop
f.Close
If InStr(1, DomFai, "proxad") Then DomFai = "free.fr"
MonSMTP = "smtp." & DomFai
Shell Environ$("comspec") & " /c Ping " & MonSMTP & " -n 1 " & " >""c:\SMTP.txt"""
TxtLigne = "": i = 0
While CmdActif = True And i < 1000
i = i + 1
Wend
Set f = fs.OpenTextFile("c:\SMTP.txt", ForReading, False)
Do While f.AtEndOfStream <> True
TxtLigne = f.ReadLine
If Left$(TxtLigne, 5) = "Envoi" Then
DebIPSmtp = InStr(1, TxtLigne, "[") + 1
FinIPSmtp = InStr(DebIPSmtp + 1, TxtLigne, "]")
Exit Do
End If
Loop
If FinIPSmtp > 0 Then MonIPSMTP = Mid$(TxtLigne, DebIPSmtp, FinIPSmtp - DebIPSmtp)
f.Close
Set f = fs.OpenTextFile(Environ$("windir") & "\system32\drivers\etc\Lmhosts", ForReading, False)
Do While f.AtEndOfStream <> True
TxtLigne = f.ReadLine
If TxtLigne = MonIPSMTP & " CurrentSmtp" Then
Exit Sub
End If
Loop
f.Close
Set f = fs.CreateTextFile(Environ$("windir") & "\system32\drivers\etc\Lmhosts", True)
f.WriteLine (MonIPSMTP & " CurrentSmtp" & vbCrLf & vbCrLf & vbCrLf & vbCrLf)
f.Close
DoEvents
Shell Environ$("comspec") & " /c nbtstat -R"
MsgBox "Mon IP Public : " & MonIPPublic & vbCrLf & "Serveur SMTP activé : " & MonSMTP
Exit Sub
OuvreUrl1:
UrlTest = "http://www.monip.org"
wnh.Open "GET", UrlTest, False
wnh.Send
If IPPublic = "" Then
IPPublic = wnh.ResponseText
DebRep = InStr(1, IPPublic, "<BR>IP : ") + 9
FinRep = InStr(DebRep, IPPublic, "<br>")
Return
ElseIf IPPublic = "http://www.monip.org" Then
OuvreUrl2:
UrlTest = "http://www.mywanip.com/?advanced=true"
wnh.Open "GET", UrlTest, False
wnh.Send
IPPublic = wnh.ResponseText
DebRep = InStr(1, IPPublic, "True Internet (WAN) Address:") + 28
FinRep = InStr(DebRep, IPPublic, "</li>")
Return
ElseIf IPPublic = "http://www.mywanip.com/?advanced=true" Then
OuvreUrl3:
UrlTest = "http://checkip.dyndns.org"
wnh.Open "GET", UrlTest, False
wnh.Send
IPPublic = wnh.ResponseText
DebRep = InStr(1, IPPublic, "Current IP Address:") + 20
FinRep = InStr(DebRep, IPPublic, "</body>")
End If
Return
TraiteErreur:
If Err.Number = -2147012889 Then
IPPublic = UrlTest
Resume Next
Else
MsgBox Err.Description & vbCrLf & Err.Number
End If
End Sub

Function CmdActif() As Boolean
Dim svc As Object
Dim sQuery As String
Dim oproc
Set svc = GetObject("winmgmts:root\cimv2")
sQuery = "SELECT * FROM win32_process"
For Each oproc In svc.execquery(sQuery)
If oproc.Name = "cmd.exe" Then CmdActif = True
Next
Set svc = Nothing
End Function

bonjour,

j'ai le meme probleme et j'ai essayé de copier ton code. déjà la variable forreading n'est pas déclaré. je l'ai donc déclarée en string. petit problème pour moi, a l'excécution j'ai une erreur permissions refusée 70.

bonjour jai changé mon adresse jexpére ke sa fonctonera bien bisous cindy balian

up s'il vous plait !

quelqu'un saurait il me répondre ?

Merci a vous !

SVP aidez moi !

N'est il pas possible d'utiliser un smtp d'hébergeur type OVH?

utilisé le logiciel : PortableThunderbird (similaire à OultookExpress et même mieux...)
comme tous logiciel portable, il s'installe et s'exécute sur clé USB
https://framakey.org/telecharger/applications-portables-libres
>> https://framakey.org/

je voudrais changer mon adresse mail sur OUTLOOCK EXPRESS
COMMENT JE FAIS MERCI D AVANCE
m

CHANGEMENT DE MAIL OUTLOOCK