Microsoft 365 Eviter un message d'erreur renvoyant vers mon code vba

[LandryK7]

Bonjour à tous,
Quand la connexion Internet est coupée j'obtiens ce message d'erreur " Run-time error '-2147012889 (80072ee7)': L'adresse ou le nom de serveur n'a pas pu être résolu"
Et mon code VBA est mis à la disposition des utilisateurs. Comment faire pour qu'une MsgBox demande à l'utilisateur de vérifier sa connexion Internet et que Mon code VBA ne soit pas exposé?

Voici mon code

Sub EnvoyerLesSMS()
'UpdatebyExtendoffice20161222
Dim x As Integer

Dim strResult As String
Dim objHTTP As Object
Dim URL As String
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")


'*******************************
'Procédure pour envoyer les SMS
'*******************************

Application.ScreenUpdating = False
' Set numrows = number of rows of data.
numrows = Sheets("Envoi").Range("E1", Range("E1").End(xlDown)).Rows.Count
numrows = numrows - 1
MsgBox numrows

End If

' Select cell a1.
'MsgBox NumRows
Sheets("Envoi").Range("E2").Select
' Establish "For" loop to loop "numrows" number of times.
For x = 2 To numrows


' Insert your code here.
' Selects cell down 1 row from active cell.
If (Range("I" & x).Value > 0) Then

URL = "https://api.budgetsms.net/sendsms/?username=" & "MONCODE" & "&userid=" & "MONUSERID" & "&handle=" & "MONHANDLE" & "&msg="


URL = URL & URLEncode(Range("D" & x).Value)
URL = URL & "&from=" & Range("F" & x).Value
URL = URL & "&to=00" & Range("E" & x).Value

' Range("H" & x).Value = URL

objHTTP.Open "GET", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
objHTTP.send ("keyword=php")
Sheets("Envoi").Range("G" & x).Value = objHTTP.responseText
Else
Sheets("Envoi").Range("G" & x).Value = "Message non envoyé"

End If

Next
Application.ScreenUpdating = True

Sheets("Envoi").Range("a2").Select
MsgBox "Messages envoyés"

1

End Sub

Public Function URLEncode(StringToEncode As String, Optional _
UsePlusRatherThanHexForSpace As Boolean = False) As String

Dim TempAns As String
Dim CurChr As Integer
CurChr = 1
Do Until CurChr - 1 = Len(StringToEncode)
Select Case Asc(Mid(StringToEncode, CurChr, 1))
Case 48 To 57, 65 To 90, 97 To 122
TempAns = TempAns & Mid(StringToEncode, CurChr, 1)
Case 32
If UsePlusRatherThanHexForSpace = True Then
TempAns = TempAns & "+"
Else
TempAns = TempAns & "%" & Hex(32)
End If
Case Else
TempAns = TempAns & "%" & _
Format(Hex(Asc(Mid(StringToEncode, _
CurChr, 1))), "00")
End Select

CurChr = CurChr + 1
Loop

URLEncode = TempAns
End Function

 

[youky(BJ)]

Bonjour Landry,
Essayez d'incorporer une gestion d'erreur comme ceci.
Non testé . . .
Bruno

On Error Resume Next
objHTTP.Open "GET", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
objHTTP.send ("keyword=php")
if Err<>0 Then MsgBox"Verifiez votre connection",vbexclamation,"ANNULATION":exit sub
Sheets("Envoi").Range("G" & x).Value = objHTTP.responseText
Else
Sheets("Envoi").Range("G" & x).Value = "Message non envoyé"

End If

 

[LandryK7]

Bonjour Landry,
Essayez d'incorporer une gestion d'erreur comme ceci.
Non testé . . .
Bruno

On Error Resume Next
objHTTP.Open "GET", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
objHTTP.send ("keyword=php")
if Err<>0 Then MsgBox"Verifiez votre connection",vbexclamation,"ANNULATION":exit sub
Sheets("Envoi").Range("G" & x).Value = objHTTP.responseText
Else
Sheets("Envoi").Range("G" & x).Value = "Message non envoyé"

End If

ça fonctionne à merveille
Merciiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii