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
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