Εμφάνιση ενός μόνο μηνύματος
  #7  
Παλιά 02-05-12, 11:47
alex Ο χρήστης alex δεν είναι συνδεδεμένος
Όνομα: Αλέξανδρος
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007, Ms-Office 2013
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 22-01-2010
Περιοχή: ΑΡΤΑ
Μηνύματα: 521
Προεπιλογή

Καλημέρα στην κοινότητα, καλό μήνα σε όλους
Καλημέρα Τάσο
Μη αφήνοντας σε εκκρεμότητα τα λεγόμενα μου με την διεκπεραίωση της εφαρμογής 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
Φιλικά/Αλέξανδρος
Απάντηση με παράθεση