Gửi tin nhắn miễn phí bằng Excel

byLãng Tử -
0
Bài viết này hoàn toàn miễn phí để giúp các bạn gửi tin nhắn hàng loạt đến khách hàng của mình một cách đơn giản nhất.

Clickatell, voipbuster hay một vài bên cung cấp ứng dụng gửi sms hàng loạt đến khách hàng. Tuy nhiên để có thể gửi được hàng loạt tin nhắn bạn cần phải biết rất nhiều kỹ năng về lập trình. Còn bạn, bạn chỉ biết mỗi cái excel và muốn vọc nó trên excel thì dưới đây là tất cả những gì dành cho bạn.


Việc đầu tiên và rất quan trọng để chạy được cái này là bạn phải mua ứng dụng gửi tin nhắn từ bên thứ 3 (vì trên đời không có cái gì cho không biếu không). bạn có thể mua clickatell hoặc voipbuster. Trong bài mình hướng dẫn chuyên về clickatell. Nếu bạn mua cái khác thì tùy chỉnh lại cho phù hợp.

Bước 1: Thiết kế cái form đẹp như cái hình ở trên. :) đổi tên thuộc tính textbox và button cho phù hợp, nếu không rành về vba thì tốt nhất nên làm theo để không bị lỗi
  • Tên form: frm_SMS
  • Textbox số điện thoại: txt_SoDT
  • Textbox  nội dung tin nhắn: txt_TinNhan
  • Button load số điện thoại: cmd_Multiple
  • Textbox đếm số ký tự trong nội dung tin nhắn: txt_Dem
  • Button load form kiểm tra: cmd_LoadCheckSMS
  • Button xóa nội dụng và sđt: cmd_Clear
  • Button send: cmd_Gui
  • Button làm mới: cmd_Refresh
  • Label credit: lbl_Balance
Bước 2: Bỏ code vào.

 Nút Send:

Private Sub cmd_Gui_Click()
    Dim From As String, USERNAME As String, PASSWORD As String, MSG As String, SDT As String, API As String, DiaChiIP As String
    Dim xml As Object
    Dim URL As String
    Dim Arr As Variant
    Dim i As Long
    Dim LastRow As Long
  
'getSpeed (True)
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Arr = Sheet1.Range("A2:A" & LastRow).Value
    DiaChiIP = GetMyPublicIP
      
    From = "sender_ID"
    USERNAME = "Tendangnhap" 'enter username here
    PASSWORD = "matkhau" 'enter password here
    API = "API_ID"
    SDT = txt_SoDT.Text
    MSG = txt_TinNhan.Text
      
    If txt_SoDT.Text = "" Or txt_TinNhan.Text = "" Then
  
        MsgBox "Ngu Ghe" & vbCrLf & vbCrLf & "Co thong tin gi dau ma bam gui"
      
    Else
        'If DiaChiIP <> "192.168.1.1" Then
            'MsgBox "Xin loi ban khong nam trong khu vuc cho phep"
        'Else
          
                    'URL = "https://www.voipbuster.com/myaccount/sendsms.php?username=" & USERNAME & "&password=" & PASSWORD & "&to=" & SDT & "&text=" & msg
                    URL = "http://api.clickatell.com/http/sendmsg?from=" & From & "&user=" & USERNAME & "&password=" & PASSWORD & "&api_id=" & API & "&to=" & SDT & "&text=" & MSG
              
                    Set xml = CreateObject("MSXML2.XMLHTTP")
                    xml.Open "GET", URL, False
                    xml.Send
                  
                    'Export csv file to desktop
                    Dim Saved As Boolean
                    Dim x As Long
                    Dim fso As Object
                    Dim oFile As Object
                                      
                    x = 1
                    Set fso = CreateObject("Scripting.FileSystemObject")
                    Do While Saved = False
                        If FileExist(Environ("USERPROFILE") & "\Desktop\" & "smsreport " & x & ".csv") = False Then
                            Set oFile = fso.CreateTextFile(Environ("USERPROFILE") & "\Desktop\" & "smsreport " & x & ".csv", True)
                            Saved = True
                        Else
                            x = x + 1
                        End If
                    Loop
                  
                    oFile.WriteLine xml.responsetext
                    oFile.Close
                    Set fso = Nothing
                    Set oFile = Nothing
                    MsgBox "Xong!" & vbCrLf & vbCrLf & "Xem file báo cáo trên desktop"
                    txt_SoDT.Text = ""
      
        'End If
    End If
'getSpeed (False)
End Sub
Function FileExist(FilePath As String) As Boolean
'PURPOSE: Test to see if a file exists or not
Dim TestStr As String
'Test File Path (ie "C:\Users\Chris\Desktop\Test\book1.xlsm")
  On Error Resume Next
    TestStr = Dir(FilePath)
  On Error GoTo 0
'Determine if File exists
  If TestStr = "" Then
    FileExist = False
  Else
    FileExist = True
  End If
End Function

Nút Clear: 

Private Sub cmd_Clear_Click()
    txt_SoDT.Text = " "
    txt_TinNhan.Text = ""
End Sub

Nút load số điện thoại:

Private Sub cmd_Multiple_Click()
    Dim i As Long, LastRow As Long
    Dim temp As String
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    If LastRow > 1 Then
    temp = Sheet1.Cells(2, "A")
    For i = 3 To LastRow
        temp = temp & "," & Sheet1.Cells(i, "A")
    Next i
    txt_SoDT.Text = temp
    End If
End Sub

Nút refresh số tin nhắn còn lại

Private Sub cmd_Refresh_Click()
    Dim URL As String
    Dim xml As Object
        URL = "http://api.clickatell.com/http/getbalance?api_id=" & "8979997" & "&user=" & "abcd" & "&password=" & "123456"
    Set xml = CreateObject("MSXML2.XMLHTTP")
    xml.Open "GET", URL, False
    xml.Send
    lbl_Balance = xml.responsetext
End Sub

Mục đếm số ký tự trong tin nhắn:

Private Sub txt_TinNhan_Change()
    txt_Dem.Text = 160 - Len(Me.txt_TinNhan.Text)
End Sub

Code khi load form:

Private Sub UserForm_Activate()
    Dim URL As String
    Dim xml As Object
        URL = "http://api.clickatell.com/http/getbalance?api_id=" & "8979997" & "&user=" & "abcd" & "&password=" & "123456"
    Set xml = CreateObject("MSXML2.XMLHTTP")
    xml.Open "GET", URL, False
    xml.Send
    lbl_Balance = xml.responsetext
  
End Sub

 Bước 3: Chạy thử để kiểm tra kết quả

Bonus: Chức năng kiểm tra kết quả tin nhắn sau khi gửi. 


Private Sub cmd_BackSMS_Click()
    Unload frm_Check
    frm_SMS.Show
End Sub
Private Sub cmd_KT_Click()
    Dim URL As String
    Dim xml As Object
    Dim MaKT As String
    Dim NumStatus As Long
    MaKT = txt_MaKT.Text
  
        URL = "http://api.clickatell.com/http/querymsg?user=" & "abcd" & "&password=" & "123456" & "&api_id=" & "8979997" & "&apimsgid=" & MaKT
      
    Set xml = CreateObject("MSXML2.XMLHTTP")
    xml.Open "GET", URL, False
    xml.Send
   If IsNumeric(Right(xml.responsetext, 3)) Then
    NumStatus = Right(xml.responsetext, 3)
    Select Case NumStatus
        Case 1
            txt_BaoKQ.Text = "Mã ki" & ChrW(7875) & "m tra không chính xác ho" & ChrW(7863) & "c báo cáo b" & ChrW(7883) & " ch" & ChrW(7853) & "m"
        Case 2
            txt_BaoKQ.Text = "Tin nh" & ChrW(7855) & "n không th" & ChrW(7875) & " g" & ChrW(7917) & "i " & ChrW(273) & "i và hi" & ChrW(7879) & "n " & ChrW(273) & "ang ch" & ChrW(7901) & " g" & ChrW(7917) & "i l" & ChrW(7841) & "i"
        Case 3
            txt_BaoKQ.Text = "Tin nh" & ChrW(7855) & "n " & ChrW(273) & "ang n" & ChrW(7857) & "m " & ChrW(7903) & " nhà m" & ChrW(7841) & "ng."
        Case 4
            txt_BaoKQ.Text = "Khách hàng " & ChrW(273) & "ã nh" & ChrW(7853) & "n " & ChrW(273) & ChrW(432) & ChrW(7907) & "c tin nh" & ChrW(7855) & "n"
        Case 5
            txt_BaoKQ.Text = "Tin nh" & ChrW(7855) & "n b" & ChrW(7883) & " l" & ChrW(7895) & "i"
        Case 6
            txt_BaoKQ.Text = "Tin nh" & ChrW(7855) & "n " & ChrW(273) & "ã b" & ChrW(7883) & " h" & ChrW(7911) & "y"
        Case 7
            txt_BaoKQ.Text = "Không th" & ChrW(7875) & " g" & ChrW(7917) & "i tin nh" & ChrW(7855) & "n " & ChrW(273) & ChrW(7871) & "n cho thi" & ChrW(7871) & "t b" & ChrW(7883) & " c" & ChrW(7847) & "m tay"
        Case 8
            txt_BaoKQ.Text = "Tin nh" & ChrW(7855) & "n " & ChrW(273) & "ang n" & ChrW(7857) & "m " & ChrW(7903) & " t" & ChrW(7893) & "ng " & ChrW(273) & "ài"
        Case 9
            txt_BaoKQ.Text = "L" & ChrW(7895) & "i khi g" & ChrW(7917) & "i tin nh" & ChrW(7855) & "n"
        Case 10
            txt_BaoKQ.Text = "Tin nh" & ChrW(7855) & "n " & ChrW(273) & "ã h" & ChrW(7871) & "t h" & ChrW(7841) & "n"
        Case 11
            txt_BaoKQ.Text = "Tin nh" & ChrW(7855) & "n " & ChrW(273) & "ang ch" & ChrW(7901) & " g" & ChrW(7917) & "i l" & ChrW(7841) & "i"
        Case 12
            txt_BaoKQ.Text = "H" & ChrW(7871) & "t ti" & ChrW(7873) & "n, không th" & ChrW(7875) & " g" & ChrW(7917) & "i " & ChrW(273) & ChrW(432) & ChrW(7907) & "c tin nh" & ChrW(7855) & "n."
        Case 14
            txt_BaoKQ.Text = "S" & ChrW(7889) & " ti" & ChrW(7873) & "n v" & ChrW(432) & ChrW(7907) & "t quá m" & ChrW(7913) & "c cho phép."
        End Select
    Else
        txt_BaoKQ.Text = "Kiem Tra lai Ma"
    End If
  
  
End Sub

Để có thể hoạt động trên file excel khi mở form thêm vbModeless vào sau lệnh gọi form. Ví dụ:
  • frm_SMS.Show vbModeless 
Hãy vận dụng chất xám của bản thân để hoàn thiện một phiên bản phù hợp hơn và đẹp hơn với mình.
Tags:
Đăng nhận xét (0)
Mới hơn Cũ hơn