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

예전에 카톡 메세지 보내는 엑셀 파일을 올렸는데 거의 2년반만에 새롭게 만들어 봤어요.

 

원본 소스는 "오빠두엑셀"에서 참고했으며, 인터넷의 python의 카톡 메세지 발송 포스팅 글들을 참고했습니다.

이전글 (엑셀에서 카카오톡 메세지 보내기)에서는 친구목록으로 메세지를 발송했었는데,

이번에는 채팅방 목록에서 채팅방 이름으로 메세지를 발송하도록 변경하였습니다.

친구목록을 사용하실 분들은 이전 포스팅을 참고해주세요.

 

달라진 부분은 발송방법을 문자와 그림의 두가지로 발송되게 만들었고, C3셀에서 선택하게끔 만들었습니다.

 

문자의 경우 I3셀부터 아래로 입력된 모든 셀의 내용을 전송합니다.

그림의 경우 C4셀에 입력한 범위를 복사해서 카톡 메세지로 붙여넣기 하는 방식으로 발송합니다.

단, 그림 전송의 경우 예전부터 발송이 안되는 이슈가 있었기에 대화방이 열리고 발송이 안되는 경우가 발생할 수도 있습니다.

이를 해결하기 위해 딜레이 타임을 1초씩 중간중간에 넣어줬으며,

for문을 돌리거나, sleep를 사용하는 대신 wait를 사용해서 딜레이 타임을 넣어줬습니다.

 

※ 채팅창이 열려있을경우 오류가 발생하니 채팅창은 모두 닫고 실행해 주세요.

 

더보기를 누르시면 코드를 확인하실 수 있습니다.

 

메인 모듈 입니다.

Option Explicit

Sub SendKakaoMsgs()

    Dim Rng As Range
    Dim rngMsg As Range
    Dim SendAsImage As Boolean
    Dim blnPass As Boolean
    Dim rngUserName As Range
    Dim shopName As Range
    Dim chkRunChat As Boolean
    
    Application.ScreenUpdating = False        '화면 업데이트 (일시)정지
    
    If Range("C3").Value = "그림" Then
        SendAsImage = True
        Set rngMsg = Range(Range("C4").Value)
    Else
        SendAsImage = False
        Set rngMsg = Range(Range("I3"), Cells(Rows.Count, "I").End(3))
    End If
    
    Set rngUserName = Range(Range("F3"), Cells(Rows.Count, "F").End(3))
    
    For Each shopName In rngUserName
        ' 그림 범위 복사
        If SendAsImage = True Then
            Call CopyRangeAsImage(rngMsg)
        End If
        
        '채팅창 열기
        Call Call_ChatRoom(shopName)
        ' 딜레이
        Application.Wait Now + TimeValue("0:00:01")
    
        ' 카톡 보내기
        If SendAsImage = True Then  ' 그림
            chkRunChat = Send_Kakao_Img(shopName)
        Else                        ' 문자
            chkRunChat = Send_Kakao(shopName, rngMsg)
        End If
                
        ' 채팅창 오류 발생시 종료
        If chkRunChat = False Then Exit Sub
    Next shopName

    MsgBox "전송을 완료했습니다."

End Sub

 

카톡 관련 windows api 모듈 입니다.

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
'https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-keybd_event
Private Declare PtrSafe Sub keybd_event Lib "user32.dll" _
                                                            (ByVal bVk As Byte, _
                                                            ByVal bScan As Byte, _
                                                            ByVal dwFlags As Long, _
                                                            ByVal dwExtraInfo As Long)
'https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-getclassname
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" _
                                                            (ByVal hWnd As Long, _
                                                            ByVal lpClassName As String, _
                                                            ByVal nMaxCount As Long) As Long
'https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-getwindow
Public Declare PtrSafe Function GetWindow _
                                                        Lib "user32" _
                                                        (ByVal hWnd As Long, _
                                                        ByVal wCmd As Long) As Long
Private Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hWnd As Long, ByVal wFlag As Long) 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
'https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-keybd_event
Private Declare Sub keybd_event Lib "user32.dll" _
                                                            (ByVal bVk As Byte, _
                                                            ByVal bScan As Byte, _
                                                            ByVal dwFlags As Long, _
                                                            ByVal dwExtraInfo As Long)
'https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-getclassname
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
                                                            (ByVal hwnd As Long, _
                                                            ByVal lpClassName As String, _
                                                            ByVal nMaxCount As Long) As Long
'https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-getwindow
Public Declare Function GetWindow _
                                                        Lib "user32" _
                                                        (ByVal hwnd As Long, _
                                                        ByVal wCmd As Long) As Long
Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
#End If

Private Const WM_SETTEXT = &HC: Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101: Private Const VK_RETURN = &HD
Private Const GW_HWNDNEXT = &H2
Private Const VK_UP = &H26:     Private Const VK_CONTROL = &H11
Private Const VK_V = &H56:      Private Const VK_ESC = &H1B
Private Const KEYEVENTF_KEYUP As Long = 2

Dim Handle As Long      '윈도우 핸들을 저장할 변수
Dim HandleEx As Long    '자식 윈도우 핸들을 저장할 변수

Dim hwnd_KakaoTalk As Long: Dim hwnd_RichEdit As Long
Dim sPath As String

' 문자 메세지
Public Function Send_Kakao(Target As Range, msg As Range) As Boolean
 
    Dim SendTo$: SendTo = Target.Value
    Dim message As String
    Dim cell As Range
     
    ' 범위의 각 셀을 순회하며 문자열에 추가
    For Each cell In msg
        message = message & cell.Value & Chr(10) ' Chr(10)은 개행 문자(엔터)를 나타냅니다.
    Next cell

    ' 마지막 개행 문자(엔터) 제거
    message = Left(message, Len(message) - 1)

    Dim hwnd_KakaoTalk As Long: Dim hwnd_RichEdit As Long
     
    hwnd_KakaoTalk = FindWindow(vbNullString, SendTo)
    hwnd_RichEdit = FindWindowEx(hwnd_KakaoTalk, 0, "RichEdit50W", vbNullString)
     
    If hwnd_RichEdit = 0 Then
        MsgBox SendTo & "의 채팅창이 실행되지 않았습니다." & vbCrLf & "프로세스를 종료합니다.", vbCritical
        Send_Kakao = False
        Exit Function
    End If
     
    ' 메세지 발송
    Call SendMessage(hwnd_RichEdit, WM_SETTEXT, 0, ByVal message)
    Call PostMessage(hwnd_RichEdit, WM_KEYDOWN, VK_RETURN, 0)
    
    ' 딜레이
    Application.Wait Now + TimeValue("0:00:01")
    ' 채팅창 닫기
    Call PostMessage(hwnd_KakaoTalk, WM_KEYDOWN, VK_ESC, 0)
 
    Send_Kakao = True
    
End Function

' 그림 메세지
Public Function Send_Kakao_Img(Target As Range) As Boolean

    Dim SendTo$: SendTo = Target.Value
    
    hwnd_KakaoTalk = FindWindow(vbNullString, SendTo)
    hwnd_RichEdit = FindWindowEx(hwnd_KakaoTalk, 0, "RichEdit50W", vbNullString)
     
    If hwnd_RichEdit = 0 Then
        MsgBox SendTo & "의 채팅창이 실행되지 않았습니다." & vbCrLf & "프로세스를 종료합니다.", vbCritical
        Send_Kakao_Img = False
        Exit Function
    End If
     
    ' Ctrl 입력
    keybd_event VK_CONTROL, 0, 0, 0
    ' 딜레이
    Application.Wait Now + TimeValue("0:00:01")
    ' V 입력
    Call PostMessage(hwnd_RichEdit, WM_KEYDOWN, VK_V, 0)            ' V
    ' 딜레이
    Application.Wait Now + TimeValue("0:00:01")
    ' Ctrl키 올림
    keybd_event VK_CONTROL, 0, KEYEVENTF_KEYUP, 0
    ' 딜레이
    Application.Wait Now + TimeValue("0:00:01")
    ' 엔터키 입력
    keybd_event VK_RETURN, 0, 0, 0
    ' 딜레이
    Application.Wait Now + TimeValue("0:00:01")
    ' 엔터키 입력
    keybd_event VK_RETURN, 0, 0, 0
    ' 딜레이
    Application.Wait Now + TimeValue("0:00:01")
    
    ' 채팅창 닫기
    Call PostMessage(hwnd_KakaoTalk, WM_KEYDOWN, VK_ESC, 0)
    
    Send_Kakao_Img = True

End Function

Public 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에 저장한다.
        HandleEx = FindWindowEx(HandleEx, 0, "EVA_Window", vbNullString)  '자식 윈도우1의 클래스명을 대입하여 자식 윈도우2 값을 HandleEx에 저장한다.
        HandleEx = GetNextWindow(HandleEx, GW_HWNDNEXT)  '자식 윈도우2의 다음 윈도우의 클래스를 HandleEx에 저장한다.
        HandleEx = FindWindowEx(HandleEx, 0, "Edit", vbNullString)  '자식 윈도우2를 대입하여 자식 윈도우3 값을 HandleEx에 저장한다.
        '// 자식 윈도우 3이 대화방 검색창
        
        Call SendMessage(HandleEx, WM_SETTEXT, 0, ByVal ChatRoom)
        Call PostMessage(HandleEx, WM_KEYDOWN, VK_UP, 0)
        ' 딜레이
        Application.Wait Now + TimeValue("0:00:01")
        Call PostMessage(HandleEx, WM_KEYDOWN, VK_RETURN, 0)
    End If
    
End Sub

'############################
' 범위를 그림으로 변경
'############################
Sub CopyRangeAsImage(Rng As Variant)

Dim i As Long
On Error GoTo Retry:

Retry:
Rng.CopyPicture
' 딜레이
Application.Wait Now + TimeValue("0:00:01")
Rng.Parent.Paste
' 딜레이
Application.Wait Now + TimeValue("0:00:01")
Selection.Cut

End Sub

카카오톡 보내기.xlsm

0.03MB