Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

LandryK7

XLDnaute Nouveau
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
 
Solution
Bonjour Landry,
Essayez d'incorporer une gestion d'erreur comme ceci.
Non testé . . .
Bruno
VB:
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

youky(BJ)

XLDnaute Barbatruc
Bonjour Landry,
Essayez d'incorporer une gestion d'erreur comme ceci.
Non testé . . .
Bruno
VB:
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

XLDnaute Nouveau

ça fonctionne à merveille
Merciiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…