Changement d'adresse SMTP sur Outlook express
Fermé
technman
Messages postés
5
Date d'inscription
lundi 4 octobre 2004
Statut
Membre
Dernière intervention
3 mai 2006
-
25 avril 2006 à 13:31
MOMO - 15 janv. 2011 à 12:56
MOMO - 15 janv. 2011 à 12:56
A voir également:
- Changement d'adresse SMTP sur Outlook express
- Darkino nouvelle adresse - Guide
- Rechercher ou entrer l'adresse - Guide
- Changer adresse dns - Guide
- Darkino : le grand site pirate change d'adresse et d'interface - Accueil - Services en ligne
- Creer adresse mail outlook - Guide
10 réponses
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
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.
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.
technman
Messages postés
5
Date d'inscription
lundi 4 octobre 2004
Statut
Membre
Dernière intervention
3 mai 2006
25 avril 2006 à 22:46
25 avril 2006 à 22:46
up s'il vous plait !
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
technman
Messages postés
5
Date d'inscription
lundi 4 octobre 2004
Statut
Membre
Dernière intervention
3 mai 2006
26 avril 2006 à 10:52
26 avril 2006 à 10:52
quelqu'un saurait il me répondre ?
Merci a vous !
Merci a vous !
technman
Messages postés
5
Date d'inscription
lundi 4 octobre 2004
Statut
Membre
Dernière intervention
3 mai 2006
29 avril 2006 à 14:34
29 avril 2006 à 14:34
SVP aidez moi !
Salut,
Je ne c pas si tu as tjrs besoin de la réponse mais pour changer l'adresse smtp dans outlook il te suffit de faire "outils", puis "comptes", puis selectionne le compte à modifier, puis "proprietés".
Sous l'onglet "serveurs" tu ppourras modifer smtp et pop et mot de passe.
Voila, j'espère avoir aidé un petit peu.
MadCow
Je ne c pas si tu as tjrs besoin de la réponse mais pour changer l'adresse smtp dans outlook il te suffit de faire "outils", puis "comptes", puis selectionne le compte à modifier, puis "proprietés".
Sous l'onglet "serveurs" tu ppourras modifer smtp et pop et mot de passe.
Voila, j'espère avoir aidé un petit peu.
MadCow
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/
comme tous logiciel portable, il s'installe et s'exécute sur clé USB
https://framakey.org/telecharger/applications-portables-libres
>> https://framakey.org/