Καλημέρα στην κοινότητα, καλό μήνα σε όλους
Καλημέρα Τάσο
Μη αφήνοντας σε εκκρεμότητα τα λεγόμενα μου με την διεκπεραίωση της εφαρμογής SMS οφείλω χρέος ενημέρωσης του αντικειμένου.
Τελικά κατέληξα κατά κάποιο τρόπο στο ότι χρειάζομαι συνεργασία με κάποια εταιρεία για να στείλω μαζικά
(SMS).
Από όνομα χρήστη,κωδικό,μέχρι τέλος στη προπληρωμή μηνυμάτων.
Χρησιμοποίησα το
API που δίνουν όλες οι εταιρείες είτε είναι σε asp ή php to Website βάζοντας ένα πεδίο (webtxt).
Χρησιμοποίησα ένα reference ΧΜL ,και create object για τις ιδιότητες.
Έτσι όταν η βάση σου είναι κλειδωμένη έχει την ευεληξία κινήσεων αλλαγής εταιρείας.
Δεν κατάφερα με το τρόπο που μου έγραψες (InternetExplorer)να στο προσαρμόσω να στείλω μήνυμα.
Έτσι βρίσκοντας το οικονομικό πακέτο κάποιας εταιρείας βάζεις το αντίστοιχο website που σου δίνει η εκάστοτε εταιρεία είτε είναι asp είτε php ,βγάζεις και τα :Username, password της συγκεκριμένης εταιρείας.
Έφτιαξα και ένα δεύτερο πεδίο webtxt1 όπου βάζοντας ένα url για credit μου επιστρέφει την τιμή του υπολοίπου ex.
Credit:0.00
Έχω όμως μια ερώτηση το μήνυμα της access που επιστρέφει την τιμή πχ.
Credit:0.00 ή ότι άλλοΠχ.όταν το μήνυμα σταλεί μου επιστρέφει ΠΧ.
Μid 000E83 που σημαίνει ότι το μήνυμα στάλθηκε .
Πώς μπορώ να το περάσω σε πίνακα για αποθήκευση;
Αν και πιστεύω καλύτερα είναι η αποθήκευση εκτός βάσης για το θέμα υπερφόρτωσης(όγκου).
Απλά ΄δεν χρησιμοποίησα στην μαζική αποστολή το check box αλλά με κώδικα μετέφερα τα επιλεγμένα κινητά τηλέφωνα σε πεδίο
(txtTo)που ορίζετε απο την εταιρεία με την ίδια ονομασία.
Ο κωδικας που χρησιμοποίησα για την αποστολή είναι ο εξής¨:
Κώδικας:
Public Function WinHTTPPostRequest(url As String, FormData As String) As String
Dim http As New MSXML2.XMLHTTP
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", url & "?" & FormData, False
http.setRequestHeader "Content-Type", "multipart/form-data; "
http.send FormData
WinHTTPPostRequest = http.responseText
End Function
Public Function URLEncode(ByVal StringToEncode As String) As String
If StringToEncode = "" Then
URLEncode = ""
Exit Function
End If
Dim i As Integer
Dim iAsc As Long
Dim sTemp As String
Dim ByteArrayToEncode() As Byte
ByteArrayToEncode = ADO_EncodeUTF8(StringToEncode)
For i = 0 To UBound(ByteArrayToEncode)
iAsc = ByteArrayToEncode(i)
Select Case iAsc
Case 32 'space
sTemp = "+"
Case 48 To 57, 65 To 90, 97 To 122
sTemp = Chr(ByteArrayToEncode(i))
Case Else
'Debug.Print iAsc
sTemp = "%" & Hex(iAsc)
End Select
URLEncode = URLEncode & sTemp
Next
End Function
'Purpose: UTF16 to UTF8 using ADO
Public Function ADO_EncodeUTF8(ByVal strUTF16 As String) As Byte()
Const adTypeBinary As Long = 1
Const adTypeText As Long = 2
Const adModeReadWrite As Long = 3
Dim objStream As Object
Dim data() As Byte
If strUTF16 = "" Then
ADO_EncodeUTF8 = data
Exit Function
End If
Set objStream = CreateObject("ADODB.Stream")
objStream.CharSet = "utf-8"
objStream.Mode = adModeReadWrite
objStream.Type = adTypeText
objStream.Open
objStream.WriteText strUTF16
objStream.flush
objStream.Position = 0
objStream.Type = adTypeBinary
objStream.Read 3 ' skip BOM
data = objStream.Read()
objStream.Close
ADO_EncodeUTF8 = data
End Function
Private Sub btn2SendSMS_Click()
'Dim data As String
' data = "username=" & Nz(Me.txtUsername) & _
' "&password=" & Nz(Me.txtPassword) & _
' "&from=" & Nz(Me.txtFrom) & _
' "&to=" & Nz(Me.txtTo) & _
' "&message=" & URLEncode(Nz(Me.txtMessage))
' Dim result As String
' result = WinHTTPPostRequest(Me.txtWebsite3, data)
' MsgBox result
End Sub
Private Sub btn3SendSMS_Click()
' Dim data As String
' data = "username=" & Nz(Me.txtUsername) & _
' "&password=" & Nz(Me.txtPassword) & _
' "&from=" & Nz(Me.txtFrom) & _
' "&to=" & Nz(Me.txtTo) & _
' "&message=" & URLEncode(Nz(Me.txtMessage))
' Dim result As String
' result = WinHTTPPostRequest(Me.txtWebsite4, data)
' MsgBox result
End Sub
Private Sub btn4SendSMS_Click()
' Dim data As String
' data = "username=" & Nz(Me.txtUsername) & _
' "&password=" & Nz(Me.txtPassword) & _
' "&from=" & Nz(Me.txtFrom) & _
' "&to=" & Nz(Me.txtTo) & _
' "&message=" & URLEncode(Nz(Me.txtMessage))
' Dim result As String
' result = WinHTTPPostRequest(Me.txtWebsite5, data)
' MsgBox result
End Sub
Private Sub btnSendSMS_Click()
Dim data As String
data = "username=" & Nz(Me.txtUsername) & _
"&password=" & Nz(Me.txtPassword) & _
"&from=" & Nz(Me.txtFrom) & _
"&to=" & Nz(Me.txtTo) & _
"&message=" & URLEncode(Nz(Me.txtMessage))
Dim pp As Variant, p As Variant, i As Long, cnt As Long
DoCmd.SetWarnings False
pp = Split(txtTo, ",")
If txtTo = "" Then
MsgBox ("Συμπληρώστε υποχρεωτικά και τα 3 πεδία που είναι μαρκαρισμένα με αστεράκι)
Else
cnt = UBound(pp) + 1
If MsgBox("Έχετε επιλέξει " & cnt & " παραλήπτες." & vbNewLine & "¸έναρξη αποστολής ", _
vbQuestion + vbOKCancel + vbDefaultButton2, "Αποστολή πολαπλών μηνυμάτων(SMS)") <> vbOK Then Exit Sub
Dim result As String
result = WinHTTPPostRequest(Me.txtWebsite, data)
MsgBox result
End If
End Sub
Private Sub btn1SendSMS_Click()
Dim data As String
data = "username=" & Nz(Me.txtUsername) & _
"&password=" & Nz(Me.txtPassword) & _
"&from=" & Nz(Me.txtFrom) & _
"&to=" & Nz(Me.txtTo) & _
"&message=" & URLEncode(Nz(Me.txtMessage))
Dim result As String
result = WinHTTPPostRequest(Me.txtWebsite2, data)
MsgBox result
End Sub
Φιλικά/Αλέξανδρος