Ανανέωση ιστοσελίδας
ms-office.gr > Forum > Microsoft Access > Access - Ερωτήσεις / Απαντήσεις > [ Active X Controls ] Αποστολή SMS από Access

Access - Ερωτήσεις / Απαντήσεις Access + VBA... Εδώ δεν υπάρχουν όρια!

Απάντηση στο θέμα

 

Εργαλεία Θεμάτων Τρόποι εμφάνισης
  #1  
Παλιά 16-03-13, 18:15
Όνομα: Πάνος
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 02-03-2011
Μηνύματα: 26
Προεπιλογή Αποστολή SMS από Access

Καλησπέρα! θέλω να στέλνω sms σε κάθε ένα πελάτη ξεχωριστά αλλά και σε όλους μαζί!
μπορεί κάποιός να με βοηθήσει?
Απάντηση με παράθεση
  #2  
Παλιά 16-03-13, 20:41
Όνομα: Αλέξανδρος
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007, Ms-Office 2013
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 22-01-2010
Περιοχή: ΑΡΤΑ
Μηνύματα: 521
Προεπιλογή

Καλησπέρα Πάνο!!!

Κάνε κάποια βάση μέχρι ένα σημείο και από εκεί και πέρα να σε βοηθήσουμε.
ΠΧ.
1.Δηλαδή Μιά βάση με κάποιο πελατολόγιο.
2. Να βρείς κάποια εταιρεία να σου δώσει το active x και να στέλνεις μυνήματα .
3.Μπορείς και μέσω ιντερνετ.
Επίσης σε κάποιο θέμα μέσα απο το forum μπορείς να πάρεις κάποιες ιδέες.

Φιλικά/Αλέξανδρος

Υ/Γ: Πρέπει να ξέρεις ότι για να στέλνεις SMS θα πρέπει να προπληρώσεις μηνύματα απο κάποια εταιρεία
Απάντηση με παράθεση
  #3  
Παλιά 19-03-13, 15:41
Όνομα: Αλεξια
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 04-02-2013
Μηνύματα: 22
Προεπιλογή

καλησπερα πανο
Νομιζω ότι έχω αυτό που ζητάς.

Option Compare Database
Enum enmSubmitMethod
enmPOST = 1
enmGET = 2
End Enum
Private objXMLHTTP As MSXML2.XMLHTTP
Function sms_apostoli(kinito As String, minima As String) As String

Dim Apostoleas As String
Dim url As String
Dim myarr1
Dim myarr2
Dim reply As String
Dim Sms As String
Dim sender As String
Dim txt_receiver As String


Apostoleas = "" εδω το ονομα του αποστολεα

sender = URLEncode(Apostoleas)
Sms = URLEncode(minima)
txt_receiver = "30" & kinito


url = "http://attenzoservices.com/api_http2/http?"
myarr1 = Array("user", "pass", "from", "text", "to", "text")
myarr2 = Array("εδω το user", "εδω ο κωδικος", sender, Sms, txt_receiver)
reply = send(url, myarr1, myarr2)


'url = "http://www.bulk-sms.gr/messenger/customers/v3/smsc.asp?"
'myarr1 = Array("user", "pass", "action", "from", "to", "text", "typesms")
'myarr2 = Array("", "", "sendsms", sender, txt_receiver, Sms, "sms")
'reply = send(url, myarr1, myarr2)


'MsgBox reply

End Function

Private Function send(Addressurl As String, myarr1, myarr2)

Dim PageResults As String

Set objXMLHTTP = New MSXML2.XMLHTTP

PageResults = SubmitDataAsString(Addressurl, 1, myarr1, myarr2)


send = PageResults

End Function

Private Function SubmitDataAsString(URLString As String, SubmitMethod As enmSubmitMethod, FormInputArray As Variant, FormValueArray As Variant) As String

' URLString is the URL that is to be requested
' FormInputArray are the names of the <INPUT> tags
' FormValueArray are the actual values of the corresponding <INPUT> tags

Dim iCount As Integer

On Error Resume Next
' There are 2 different types of Submit methods, POST and GET
' POST method has the form name/values in the message body whereas
' GET method shows it on the URL
' So we need to manipulate the parameters passed in differently based on the requested
' methods

If SubmitMethod = enmPOST Then

' Set the URL property to the Requested URL
mURL = URLString

' Set the method of request which is POST and the URL,and set the Async parameter to false
objXMLHTTP.Open "POST", URLString, False

' Sets the header so that the web server knows a form is going to be posted
objXMLHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"

' Construct the message body first before we send, it is a name/value pair,separated by ampersands
' which looks like "username=skeevs&password=aaa"
For iCount = 0 To UBound(FormInputArray)
strBody = strBody & FormInputArray(iCount) & "=" & FormValueArray(iCount) & "&"
Next

' Need to remove the last ampersand which was added in the FOR Loop above, so we use the LEFT function
objXMLHTTP.send Left(strBody, Len(strBody) - 1)

ElseIf SubmitMethod = enmGET Then

Dim strURLParam As String
Dim strURL As String

' Construct the URL first , it is a name/value pair,separated by ampersands
For iCount = 0 To UBound(FormInputArray)
strURLParam = strURLParam & FormInputArray(iCount) & "=" & FormValueArray(iCount) & "&"
Next

' Need to remove the last ampersand which was added in the FOR Loop above, so we use the LEFT function
strURLParam = Left(strURLParam, Len(strURLParam) - 1)

' Construct the URL string for the GET method
strURL = URLString & "?" & strURLParam

' Set the URL property to the Requested URL
mURL = strURL

' Set the method of request which is POST and the URL
objXMLHTTP.Open "GET", strURL, False

' Sets the header so that the web server knows a form is going to be posted
objXMLHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
'objxmlhttp.
' Send the constructed URL
objXMLHTTP.send strURL

End If

SubmitDataAsString = objXMLHTTP.responseText

End Function
Private Function URL_Encode(input_text As String) ' auto edo einai gia tin bulk sms

Dim count As Integer
Dim one_char As String

URL_Encode = ""

For count = 1 To Len(input_text)
one_char = Mid(input_text, count, 1)


If InStr("0123456789ABCDEFGHIJKLMNOPRSTUVWXYZ", UCase(one_char)) = 0 Then
one_char = "%" & Right(Hex(Asc(one_char)), 2)
End If
URL_Encode = URL_Encode & one_char
Next

End Function
Public Function URLEncode(ByVal StringToEncode As String) As String ' ÊÁÉ ÁÕÔÏ ÅÉÍÁÉ ÃÉÁ ÔÇÍ attenzoservices

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
Public Function ADO_EncodeUTF8(ByVal strUTF16 As String) As Byte() 'ÊÁÉ ÁÕÔÏ ÅÄÙ ÅÉÍÁÉ ÃÉÁ ÔÇÍ attenzoservices

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


Ανοιξε μια function και βαλτο μεσα όπως το βλεπεις

είναι κωδικας για 2 εταιρειες με sms

αλεξια
Απάντηση με παράθεση
Απάντηση στο θέμα


Δικαιώματα - Επιλογές
Δε μπορείτε να δημοσιεύσετε νέα μηνύματα
Δε μπορείτε να δημοσιεύσετε απαντήσεις
Δεν μπορείτε να επισυνάψετε αρχεία
Δεν μπορείτε να επεξεργαστείτε τα μηνύματα σας

Ο κώδικας ΒΒ είναι σε λειτουργία
Τα Smilies είναι σε λειτουργία
Ο κώδικας [IMG] είναι σε λειτουργία
Ο κώδικας HTML είναι εκτός λειτουργίας
Trackbacks are εκτός λειτουργίας
Pingbacks are εκτός λειτουργίας
Refbacks are εκτός λειτουργίας


Παρόμοια Θέματα

Θέμα Δημιουργός Forum Απαντήσεις Τελευταίο Μήνυμα
[ Φόρμες ] Αποστολή Email mgeorge Access - Ερωτήσεις / Απαντήσεις 8 30-03-16 19:33
[ Φόρμες ] Αποστολή fax από Access marpapa Access - Ερωτήσεις / Απαντήσεις 8 26-05-13 23:00
Αποστολή email από Access dmarop Access - Ερωτήσεις / Απαντήσεις 1 20-05-13 21:28
Αποστολη sms Panos Mixos Access - Ερωτήσεις / Απαντήσεις 3 04-01-13 19:18
Αποστολή email από την Access mgeorge Access - Ερωτήσεις / Απαντήσεις 10 13-08-12 23:25


Η ώρα είναι 20:09.