엑셀 x 카카오톡 문자 보내기, 1분이면 설정 완료!

Option Explicit
 
#If VBA7 Then
' https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-findwindowa
Private Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
                                                        (ByVal lpClassName As String, _
                                                        ByVal lpWindowName As String) As Long
' https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-findwindowexa
Public Declare PtrSafe Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _
                                                            (ByVal hwndParent As Long, _
                                                            ByVal hwndChildAfter As Long, _
                                                            ByVal lpszClass As String, _
                                                            ByVal lpszWindow As String) As Long
' https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-sendmessagea
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
                                                            (ByVal hwnd As Long, _
                                                            ByVal wMsg As Long, _
                                                            ByVal wParam As Long, _
                                                            ByRef lParam As Any) As Long
'https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-postmessagea
Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" _
                                                            (ByVal hwnd As Long, _
                                                            ByVal wMsg As Long, _
                                                            ByVal wParam As Long, _
                                                            ByRef lParam As Any) As Long
#Else
' https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-findwindowa
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
                                                        (ByVal lpClassName As String, _
                                                        ByVal lpWindowName As String) As Long
' https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-findwindowexa
Public Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _
                                                            (ByVal hwndParent As Long, _
                                                            ByVal hwndChildAfter As Long, _
                                                            ByVal lpszClass As String, _
                                                            ByVal lpszWindow As String) As Long
' https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-sendmessagea
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                                                            (ByVal hwnd As Long, _
                                                            ByVal wMsg As Long, _
                                                            ByVal wParam As Long, _
                                                            ByRef lParam As Any) As Long
'https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-postmessagea
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
                                                            (ByVal hwnd As Long, _
                                                            ByVal wMsg As Long, _
                                                            ByVal wParam As Long, _
                                                            ByRef lParam As Any) As Long
#End If
 
Sub Send_Kakao(Target As Range, Msg As Range)
 
Dim SendTo$: SendTo = Target.Value
Dim Message$: Message = Msg.Value
 
Dim hwnd_KakaoTalk As Long: Dim hwnd_RichEdit As Long
Const WM_SETTEXT = &HC: Const WM_KEYDOWN = &H100
Const WM_KEYUP = &H101: Const VK_RETURN = &HD
 
hwnd_KakaoTalk = FindWindow(vbNullString, SendTo)
hwnd_RichEdit = FindWindowEx(hwnd_KakaoTalk, 0, "RichEdit50W", vbNullString)
' PC 카톡버전 Ver. 3.1.2.2472 이전 버전을 사용중일 경우 RichEdit50W 을 RichEdit20W 로 수정해주세요.
 
If hwnd_RichEdit = 0 Then MsgBox SendTo & "의 채팅창이 실행되었는지 확인하세요.": Exit Sub
 
Call SendMessage(hwnd_RichEdit, WM_SETTEXT, 0, ByVal Message)
Call PostMessage(hwnd_RichEdit, WM_KEYDOWN, VK_RETURN, 0)
 
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim 사용자명 As String: 사용자명 = "A1"        '<<- 사용자명이 입력된 셀 주소를 입력하세요.
Dim 보낼메세지 As String: 보낼메세지 = "A1"    '<<- 보낼메세지가 입력된 셀주소를 입력하세요.
 
If Target.Address(False, False) = 사용자명 Or Target.Address(False, False) = 보낼메세지 Then
    Send_Kakao Range(사용자명), Range(보낼메세지)
End If
 
End Sub

' 카카오톡 채팅방과 편집창의 고유값을 반환합니다.
hwnd_KakaoTalk = FindWindow(vbNullString, SendTo)
hwnd_RichEdit = FindWindowEx(hwnd_KakaoTalk, 0, "RichEdit20W", vbNullString)

' 편집창으로 받아온 값이 없을 경우 안내메세지를 출력 후 명령문을 종료합니다.
If hwnd_RichEdit = 0 Then MsgBox SendTo & "의 채팅창이 실행되었는지 확인하세요.": Exit Sub

' 메세지 전송 후 명령문을 종료합니다.
Call SendMessage(hwnd_RichEdit, WM_SETTEXT, 0, ByVal Message)
Call PostMessage(hwnd_RichEdit, WM_KEYDOWN, VK_RETURN, 0)