Gửi tin nhắn WhatsApp bằng VBA

Liên hệ QC

goodlife1605

Thành viên mới
Tham gia
14/8/12
Bài viết
20
Được thích
40
Chào các Anh/Chị,

Các Anh/Chị cho em hỏi, em có tham khảo trên mạng và mày mò và viết đoạn code sau đây để gửi tin nhắn trên WhatsApp bằng VBA:

Sub WhatsApp()
Dim IE As Object
Dim phone As String
Dim msg As String

phone = +123456789
msg = "Good day"


Set IE = CreateObject("Shell.Application")
IE.ShellExecute "whatsapp://send?=+123456789&text=Good day"
Application.Wait Now() + TimeSerial(0, 0, 3)
SendKeys "~"

Set IE = Nothing
End Sub

------------

Đoạn code trên hoạt động tốt, nhưng xảy ra hai trường hợp sau:
1. Nếu đặt biến cho số điện thoại (as string), không đặt biến cho nội dung tin nhắn ("good day") thì code vẫn chạy.
2. Nếu thay đoạn code IE.ShellExecute "whatsapp://send?=+123456789&text=Good day" bằng đoạn code IE.ShellExecute "whatsapp://send?phone=" & phone & "&text=" & msg thì lại không chạy được. Nhờ các Anh/Chị cao nhân trên diễn đàn giúp em sửa đoạn code trên để có thể đặt biến cho cả số điện thoại và nội dung tin nhắn ạ.

Em cảm ơn các Anh/Chị.
 
Chào các Anh/Chị,

Các Anh/Chị cho em hỏi, em có tham khảo trên mạng và mày mò và viết đoạn code sau đây để gửi tin nhắn trên WhatsApp bằng VBA:

Sub WhatsApp()
Dim IE As Object
Dim phone As String
Dim msg As String

phone = +123456789
msg = "Good day"


Set IE = CreateObject("Shell.Application")
IE.ShellExecute "whatsapp://send?=+123456789&text=Good day"
Application.Wait Now() + TimeSerial(0, 0, 3)
SendKeys "~"

Set IE = Nothing
End Sub

------------

Đoạn code trên hoạt động tốt, nhưng xảy ra hai trường hợp sau:
1. Nếu đặt biến cho số điện thoại (as string), không đặt biến cho nội dung tin nhắn ("good day") thì code vẫn chạy.
2. Nếu thay đoạn code IE.ShellExecute "whatsapp://send?=+123456789&text=Good day" bằng đoạn code IE.ShellExecute "whatsapp://send?phone=" & phone & "&text=" & msg thì lại không chạy được. Nhờ các Anh/Chị cao nhân trên diễn đàn giúp em sửa đoạn code trên để có thể đặt biến cho cả số điện thoại và nội dung tin nhắn ạ.

Em cảm ơn các Anh/Chị.
Bạn thử với code này xem:

Mã:
Sub WhatsApp()
    Dim IE As Object
    Dim phone As String, msg As String, strShellExecute As String
    
    phone = "+123456789"
    msg = "Good day"
    
    If phone = "" Or msg = "" Then Exit Sub
    
    Set IE = CreateObject("Shell.Application")
    
    strShellExecute = "whatsapp://send?=" & phone & "&text=" & msg
    
    IE.ShellExecute strShellExecute
    
    Application.Wait Now() + TimeSerial(0, 0, 3)
    SendKeys "~"
    
    Set IE = Nothing
End Sub
 
Bạn thử với code này xem:

Mã:
Sub WhatsApp()
    Dim IE As Object
    Dim phone As String, msg As String, strShellExecute As String
   
    phone = "+123456789"
    msg = "Good day"
   
    If phone = "" Or msg = "" Then Exit Sub
   
    Set IE = CreateObject("Shell.Application")
   
    strShellExecute = "whatsapp://send?=" & phone & "&text=" & msg
   
    IE.ShellExecute strShellExecute
   
    Application.Wait Now() + TimeSerial(0, 0, 3)
    SendKeys "~"
   
    Set IE = Nothing
End Sub
Em chào Anh Nghĩa,

Em cảm ơn Anh Nghĩa nhiều! Em thử chạy code Anh gửi rồi nhưng vẫn không được Anh ạ (với code không đặt biến phone và msg ban đầu của em thì khi chạy code: App Whatsapp tự động mở lên, tự vào được khung gửi tin nhắn cho số điện thoại mình cần nhắn, tự dán nội dung tin nhắn vào khung gửi tin nhắn, tự gửi tin nhắn). Anh Nghĩa có thể xem lại giúp em được không ạ?

Em cảm ơn Anh.
 
Bạn thử thế này xem

IE.ShellExecute """whatsapp://send?phone=" & phone & "&text=" & msg & """"
Chào bạn Befaint,

Cảm ơn bạn nhiều. Mình đã thử chèn đoạn code bạn gửi vào nhưng vẫn không chạy được bạn ạ, T_T không biết là bị sai chỗ nào nữa. Bạn xem giúp mình có cách nào nữa được không?
 
Chào bạn Befaint,

Cảm ơn bạn nhiều. Mình đã thử chèn đoạn code bạn gửi vào nhưng vẫn không chạy được bạn ạ, T_T không biết là bị sai chỗ nào nữa. Bạn xem giúp mình có cách nào nữa được không?

Thử thế này xem nào

PHP:
Sub sendWhatsApp()

    Dim phone As String, msg As String, strShellExecute As String
    
    phone = "+123456789"
    msg = "Good day"
    
    If phone = "" Or msg = "" Then Exit Sub

    strShellExecute = "whatsapp://send?=" & phone & "&text=" & msg
    
    Shell strShellExecute, 1
    
    Application.Wait Now() + TimeSerial(0, 0, 3)
    SendKeys "~"
    

End Sub
 
Thử thế này xem nào

PHP:
Sub sendWhatsApp()

    Dim phone As String, msg As String, strShellExecute As String
   
    phone = "+123456789"
    msg = "Good day"
   
    If phone = "" Or msg = "" Then Exit Sub

    strShellExecute = "whatsapp://send?=" & phone & "&text=" & msg
   
    Shell strShellExecute, 1
   
    Application.Wait Now() + TimeSerial(0, 0, 3)
    SendKeys "~"
   

End Sub
Cảm ơn bạn nhiều nhé nhưng code lại bị lỗi ở dòng Shell strShellExecute, 1 bạn ạ. T_T, phiền bạn xem lại giúp mình được không?
 
Bạn thử với code này xem:

Mã:
Sub WhatsApp()
    Dim IE As Object
    Dim phone As String, msg As String, strShellExecute As String
   
    phone = "+123456789"
    msg = "Good day"
   
    If phone = "" Or msg = "" Then Exit Sub
   
    Set IE = CreateObject("Shell.Application")
   
    strShellExecute = "whatsapp://send?=" & phone & "&text=" & msg
   
    IE.ShellExecute strShellExecute
   
    Application.Wait Now() + TimeSerial(0, 0, 3)
    SendKeys "~"
   
    Set IE = Nothing
End Sub
Chào anh Nghĩa,

Em thử bỏ dấu khoảng trắng trong nội dung của biến msg thì code đã chạy được (đổi "Good day" thành Goodday" thì code chạy được), nhưng như vậy thì sau khi nội dung của biến msg được add vào khung tin nhắn WhatsApp thì mình lại phải tách chữ thủ công (tách "Goodday" thành "Good day", sẽ càng bất tiện nếu nội dung dài. Em nhờ Anh xem giúp có cách nào để xử lý vấn đề này được không ạ?
 
Chào anh Nghĩa,

Em thử bỏ dấu khoảng trắng trong nội dung của biến msg thì code đã chạy được (đổi "Good day" thành Goodday" thì code chạy được), nhưng như vậy thì sau khi nội dung của biến msg được add vào khung tin nhắn WhatsApp thì mình lại phải tách chữ thủ công (tách "Goodday" thành "Good day", sẽ càng bất tiện nếu nội dung dài. Em nhờ Anh xem giúp có cách nào để xử lý vấn đề này được không ạ?
Ngay bài #1 bạn ghi:
Set IE = CreateObject("Shell.Application")
IE.ShellExecute "whatsapp://send?=+123456789&text=Good day"

Như thế thì chạy, nhưng gán biến vào thì nó lỗi, tôi cũng không biết phải làm thế nào nữa!

Thử replace " " thành "_" xem sao.
 
Bạn dùng excel phiên bản bao nhiêu?
Tin nhắn gửi đi có tiếng Việt không?
Cụ thể xem nào.
 

File đính kèm

Ngay bài #1 bạn ghi:
Set IE = CreateObject("Shell.Application")
IE.ShellExecute "whatsapp://send?=+123456789&text=Good day"

Như thế thì chạy, nhưng gán biến vào thì nó lỗi, tôi cũng không biết phải làm thế nào nữa!

Thử replace " " thành "_" xem sao.
Thành thật xin lỗi vì làm mất thời gian của Anh và mọi người. Đúng như Anh nói, ở bài #1 thì em trình bày bị sai mất rồi ạ. Thực ra ban đầu em chạy code với nội dung biến msg là 1 từ "good" để test code nhưng lúc post bài thì không nghĩ là nội dung của msg có ảnh hưởng đến code nên là thay bằng chữ "good day".
Bài đã được tự động gộp:

Bạn dùng excel phiên bản bao nhiêu?
Tin nhắn gửi đi có tiếng Việt không?
Cụ thể xem nào.
Chào bạn,

Tinh nhắn mình gửi là tiếng Anh thôi bạn ạ. Mình dùng excel 2019.
Bài đã được tự động gộp:

Bạn thử với file này xem có OK không.
Em đã điền số điện thoại theo format +84277... vào ô A2 rồi nhấn nút SEND nhưng vẫn không được Anh ạ, Excel cũng không có thông báo gì. Nếu thay chữ "Good morning" bằng 1 chữ "good" thì kết quả vẫn vậy ạ.
 
Lần chỉnh sửa cuối:
Em đã điền số điện thoại theo format +84277... vào ô A2 rồi nhấn nút SEND nhưng vẫn không được Anh ạ, Excel cũng không có thông báo gì. Nếu thay chữ "Good morning" bằng 1 chữ "good" thì kết quả vẫn vậy ạ.
Bỏ qua file đó đi, bạn thử vơi file này xem.
 

File đính kèm

Mã:
Code ping and send Whatsapp message.txt
Function Ping(strip)
Dim objshell, boolcode
Set objshell = CreateObject("Wscript.Shell")
boolcode = objshell.Run("ping -n 1 -w 1000 " & strip, 0, True)
If boolcode = 0 Then
    Ping = True
Else
    Ping = False
End If
End Function
Sub PingSystem()
Dim strip As String
Dim strPhoneNumber As String
Dim strMessage As String
Dim strPostData As String
Dim IE As Object

strPhoneNumber = Sheets("DATA").Cells(2, 1).Value

For introw = 2 To ActiveSheet.Cells(65536, 2).End(xlUp).Row
    strip = ActiveSheet.Cells(introw, 2).Value
    If Ping(strip) = True Then
        ActiveSheet.Cells(introw, 3).Interior.ColorIndex = 0
        ActiveSheet.Cells(introw, 3).Font.Color = RGB(0, 0, 0)
        ActiveSheet.Cells(introw, 3).Value = "Online"
        Application.Wait (Now + TimeValue("0:00:01"))
        ActiveSheet.Cells(introw, 3).Font.Color = RGB(0, 200, 0)
        
'Send Whatsapp Message
        strMessage = "Ping " & ActiveSheet.Cells(introw, 1).Value & " " & ActiveSheet.Cells(introw, 2).Value & " is Online"
        
'IE.navigate "whatsapp://send?phone=phone_number&text=your_message"
        strPostData = "whatsapp://send?phone=" & strPhoneNumber & "&text=" & strMessage
        Set IE = CreateObject("InternetExplorer.Application")
        IE.navigate strPostData
        Application.Wait Now() + TimeSerial(0, 0, 3)
        SendKeys "~"

        Set IE = Nothing
        
    Else
        ActiveSheet.Cells(introw, 3).Interior.ColorIndex = 0
        ActiveSheet.Cells(introw, 3).Font.Color = RGB(200, 0, 0)
        ActiveSheet.Cells(introw, 3).Value = "Offline"
        Application.Wait (Now + TimeValue("0:00:01"))
        ActiveSheet.Cells(introw, 3).Interior.ColorIndex = 6
        
'Send Whatsapp Message
        strMessage = "Ping " & ActiveSheet.Cells(introw, 1).Value & " " & ActiveSheet.Cells(introw, 2).Value & " is Offline"
        
'IE.navigate "whatsapp://send?phone=phone_number&text=your_message"
        strPostData = "whatsapp://send?phone=" & strPhoneNumber & "&text=" & strMessage
        Set IE = CreateObject("InternetExplorer.Application")
        IE.navigate strPostData
        Application.Wait Now() + TimeSerial(0, 0, 3)
        SendKeys "~"
        Set IE = Nothing
    End If
Next
End Sub
Bạn thử xem nhé
 
Bỏ qua file đó đi, bạn thử vơi file này xem.
Cảm ơn Anh Ngĩa nhiều! Em điền số điện thoại vào ô A2, điền tên "An" vào ô B2 và điền text "Good morning" vào ô C2. Sau msgbox WhatsApp DDos hiện lên thì nhấn vào nút "Yes", ngay sao đó nếu:

1. Nếu vẫn để mở file excel:
-Excel tự đổi text thành "Good mỏning" nếu Unikey đang để ở chế độ gõ tiếng Việt (Nếu để Unikey ở chế độ gõ tiếng Anh thì text vẫn là "Good morning"), và tự paste vào Sheet1 (vị trí nhập không cố định, mỗi lần chạy code có thể nhập vào vị trí khác nhau).
-Excel tự nhập "Hi An ," vào Sheet1 (vị trí nhập không cố định)
-Excel tự đổi số điện thoại từ "+842772...." thành "*4772... "và tự nhập vào Sheet1 (vị trí nhập không cố định)

2. Nếu mở WhatsApp lên thì toàn bộ 3 nội dung "Hi An ,Good mỏning" tự động được nhập vào khung emoji của WhatsApp, nhưng đối tượng nhận tin nhắn lại là khung chat đang mở sẵn (có thể là bất cứ ai) chứ không phải là người sử dụng số điện thoại "+842772...", có thể vì excel sai số điện thoại chăng?

3. Nếu mở Zalo lên thì:
-Exel tự đổi số điện thoại thành "*4772..." và nhập vào đúng khung tìm kiếm nhưng vì số điện thoại sai nên vẫn không tới được khung chat người cần gửi.
-Excel tự nhập "Hi An ," + xuống dòng + "Good morning" (lỗi chữ Good morning tương tự khi đổi chế độ nhập Unikey sang gõ tiếng Việt) vào khung chat đang mở sẵn (có thể là bất cứ ai).
Bài đã được tự động gộp:

Đây nhé
PHP:
IE.ShellExecute "whatsapp://send?phone=" & phone & "&text=" & worksheetfunction.encodeurl(msg)
Tuyệt vời bạn Befaint ạ! Cuối cùng đoạn code này đã hoàn chỉnh rồi, code chạy nhanh và rất đúng ý mình.

Cám ơn bạn Befaint, cám ơn Anh Nghĩa nhiều!

Chúc cả nhà nhiều sức khỏe!
Bài đã được tự động gộp:

Cảm ơn bạn Quyenpv nhé!

Đoạn code này mình có tham khảo trên mạng và lược bớt để phù hợp với nhu cầu của mình. Thời gian đầu sử dụng OK nhưng sau đó bị lỗi ở đoan:

Set IE = CreateObject("InternetExplorer.Application")
IE.navigate strPostData

Sau đó mình sửa lại như bên dưới thì code lại chạy được:

Set IE = CreateObject("Shell.Application")
IE.ShellExecute strPostData
 
Lần chỉnh sửa cuối:
Cảm ơn Anh Ngĩa nhiều! Em điền số điện thoại vào ô A2, điền tên "An" vào ô B2 và điền text "Good morning" vào ô C2. Sau msgbox WhatsApp DDos hiện lên thì nhấn vào nút "Yes", ngay sao đó nếu:

1. Nếu vẫn để mở file excel:
-Excel tự đổi text thành "Good mỏning" nếu Unikey đang để ở chế độ gõ tiếng Việt (Nếu để Unikey ở chế độ gõ tiếng Anh thì text vẫn là "Good morning"), và tự paste vào Sheet1 (vị trí nhập không cố định, mỗi lần chạy code có thể nhập vào vị trí khác nhau).
-Excel tự nhập "Hi An ," vào Sheet1 (vị trí nhập không cố định)
-Excel tự đổi số điện thoại từ "+842772...." thành "*4772... "và tự nhập vào Sheet1 (vị trí nhập không cố định)

2. Nếu mở WhatsApp lên thì toàn bộ 3 nội dung "Hi An ,Good mỏning" tự động được nhập vào khung emoji của WhatsApp, nhưng đối tượng nhận tin nhắn lại là khung chat đang mở sẵn (có thể là bất cứ ai) chứ không phải là người sử dụng số điện thoại "+842772...", có thể vì excel sai số điện thoại chăng?

3. Nếu mở Zalo lên thì:
-Exel tự đổi số điện thoại thành "*4772..." và nhập vào đúng khung tìm kiếm nhưng vì số điện thoại sai nên vẫn không tới được khung chat người cần gửi.
-Excel tự nhập "Hi An ," + xuống dòng + "Good morning" (lỗi chữ Good morning tương tự khi đổi chế độ nhập Unikey sang gõ tiếng Việt) vào khung chat đang mở sẵn (có thể là bất cứ ai).
Bài đã được tự động gộp:


Tuyệt vời bạn Befaint ạ! Cuối cùng đoạn code này đã hoàn chỉnh rồi, code chạy nhanh và rất đúng ý mình.

Cám ơn bạn Befaint, cám ơn Anh Nghĩa nhiều!

Chúc cả nhà nhiều sức khỏe!
Bài đã được tự động gộp:


Cảm ơn bạn Quyenpv nhé!

Đoạn code này mình có tham khảo trên mạng và lược bớt để phù hợp với nhu cầu của mình. Thời gian đầu sử dụng OK nhưng sau đó bị lỗi ở đoan:

Set IE = CreateObject("InternetExplorer.Application")
IE.navigate strPostData

Sau đó mình sửa lại như bên dưới thì code lại chạy được:

Set IE = CreateObject("Shell.Application")
IE.ShellExecute strPostData
Do tôi không xài WhatsApp nên tôi không thử cho bạn được, tôi lại sưu tầm cho bạn thêm một file nữa để bạn tham khảo.
 

File đính kèm

Dạ cho em hỏi có cách nào khi gửi tin, số đã đăng kí Whatsapp sẽ trả về giá chị OK, số chưa đăng kí whatsapp(số điện thoại đc chia sẻ qua URL là không đúng) có nghĩa là không gửi đc tin thì sẽ trả về kết qua là NOK không ạ. Em cảm ơn ạ.
 
Web KT

Bài viết mới nhất

Back
Top Bottom