엑셀에서 카카오톡 메세지 보내기

새로운 소스를 포스팅 했습니다. 여기에서 확인해 주세요.

 

원본 소스는 "오빠두엑셀"에서 가져왔습니다.

 

원본에는 카톡 대화창이 열려 있을때만 보낼수 있게 되어있는데, 댓글을 보니 채팅창이 닫혀있을때는 안정성이 떨어진다는 이유로 업데이트를 보류하고 있다고 하네요.
해서 여기저기 찾아보고 제 나름대로 업데이트를 했습니다.

 

채팅창이 간혹 안열리는 경우가 있어서 sleep로 대기시간을 1초정도 넣어줘 봤습니다.

아마도 원작자분이 얘기하신 안정성 문제가 이런 부분이 아닐까 싶은데 제 능력으론 대기시간을 주는 정도로 밖에는 다른 해결책이 떠오르지 않네요.

참고해서 연구해 보실분들은 연구해 보시면 좋을것 같습니다. 

 

시트 소스코드 입니다.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim 사용자명 As String: 사용자명 = "A2"        '<<- 사용자명이 입력된 셀 주소를 입력하세요.
Dim 보낼메세지 As String: 보낼메세지 = "B2"    '<<- 보낼메세지가 입력된 셀주소를 입력하세요.

If Intersect(Range("B2"), Target) Is Nothing Then    'B2열아 아니면 종료
    Exit Sub
End If

If Target.Address(False, False) = 사용자명 Or Target.Address(False, False) = 보낼메세지 Then
    Send_Kakao Range(사용자명), Range(보낼메세지)
End If

End Sub

 

모듈 소스코드 입니다.

 

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
Private Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)

#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
Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
#End If

Dim Handle, HandleEx As Long

Private Const WM_SETTEXT = &HC: Private Const WM_KEYDOWN = &H100
Private Const VK_RETURN = &HD:  Private Const VK_ESCAPE = &H1B
Private Const WM_CLOSE = &H10:  Private Const GW_HWNDNEXT = &H2


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

Call Call_ChatRoom(Target)
DoEvents
Sleep 1000

hwnd_KakaoTalk = FindWindow(vbNullString, SendTo)
hwnd_RichEdit = FindWindowEx(hwnd_KakaoTalk, 0, "RichEdit50W", 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)

End Sub

Private Sub Call_ChatRoom(Target As Range)
    
    Dim ChatRoom$: ChatRoom = Target.Value
    Dim rtnV As Long
    
    Handle = FindWindow("EVA_Window_Dblclk", vbNullString) '카카오톡 윈도우 핸들 값을 Handle에 저장
    
    '//찾지 못하면 에러 메세지 출력
    If Handle = 0 Then
    MsgBox "카카오톡을 실행해 주세요.", 16, "Error"
    
    Else
        HandleEx = FindWindowEx(Handle, 0, "EVA_ChildWindow", vbNullString)  '자식 윈도우1
        HandleEx = FindWindowEx(HandleEx, 0, "EVA_Window", vbNullString)  '자식 윈도우2
        HandleEx = FindWindowEx(HandleEx, 0, "Edit", vbNullString)  '자식 윈도우3
    
        Call SendMessage(HandleEx, WM_SETTEXT, 0, ByVal ChatRoom)
        DoEvents
        Sleep 1000
        
        Call PostMessage(HandleEx, WM_KEYDOWN, VK_RETURN, 0)
    End If
    
End Sub

카카오톡 메세지 보내기.xlsm

0.02MB