엑셀에서 카카오톡 메세지 가져오기

지난번 카카오톡 메세지 보내기 포스팅에 이어 이번 포스팅은 메세지 가져오는 vba 코드에 대한 포스팅입니다.

 

마찬가지로 Windows API를 사용하기때문에 직접적으로 카카오톡을 제어하는게 아니라 쉽게 말하자면 윈도우를 제어해서 복사, 붙여넣기로 메세지를 읽어오는거라 생각하시면 되겠습니다.

 

방식은 대화방 이름을 검색해서 대화방을 열고 채팅내용 전체를 선택한후 복사(ctrl+C), 복사한 클립보드 내용을 읽어서 원하는 대화 내용을 뽑아낸다. 라는 방식이 되겠습니다.

 

API 함수 선언부분에는 안쓰는것들도 포함되어 있을 수 있습니다.

카카오톡 전송하는 코드랑 같이 쓰는거에서 뽑아온거라 걸러내기 사실 힘들어서 그냥 그대로 넣었습니다.

 

메세지 가공하는 부분은 예전 포스팅의 Split, Replace, Trim 활용해서 카톡 대화내용 필요한 부분 추출하기의 내용을 살짝 바꿔서 적용한 내용입니다.

 

현재 코드는 입력한 대화방의 대화 내용을 클립보드에 복사한 뒤 오늘 날자 이후에 있는 채팅 내용을 분류하고, 분류한 내용에서 대괄호( [ ] )의 내용을 제외시킨 뒤 대화 내용만 가져옵니다.

가져온 대화 내용을 빈칸(스페이스)를 기준으로 구분해서 품명, 수량, 단위를 구분하여 A1셀부터 입력하는 코드입니다.

 

왼쪽의 카톡 내용을 우측의 형식으로 엑셀에 뿌려주는 형식입니다.

 

이번 포스팅은 따로 첨부파일은 없습니다. 

 

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

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

Private Const WM_SETTEXT = &HC: Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101: Private Const VK_RETURN = &HD
Private Const WM_CHAR = &H102:  Private Const GW_HWNDNEXT = &H2
Private Const WM_CLOSE = &H10:  Private Const VK_ESCAPE = &H1B
Private Const VK_UP = &H26:     Private Const VK_CONTROL = &H11
Private Const VK_A = &H41:      Private Const VK_C = &H43
Private Const VK_V = &H56:      Private Const VK_ESC = &H1B
Private Const VK_T = &H54
Private Const KEYEVENTF_KEYUP As Long = 2

Dim Handle As Long      '윈도우 핸들을 저장할 변수
Dim HandleEx As Long    '자식 윈도우 핸들을 저장할 변수
Dim HandleEx1 As Long   '자식 윈도우 핸들을 저장할 변수
Dim TextLen As Long     '문자를 보낼때 For돌릴 변수

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


Private Sub Get_Kakao(ChatName As String)

    Dim ChatData As String
    
    Call Call_ChatRoom_String(ChatName) '채팅방 열기
    ChatData = CopyChatroom(ChatName)   '채팅방 내용 복사
    ChatData = GetTodayChat(ChatData)   '복사한 내용
    
    Call KakaoMessageFiltering(ChatData, False) '원하는 형태로 대화 가공

End Sub


Private Sub Call_ChatRoom_String(Target As String)
    
    Dim ctext As String
    Dim dataObj As MSForms.DataObject ' Requires "Microsoft Forms 2.0 Object Library" reference
    
    Handle = FindWindow("EVA_Window_Dblclk", vbNullString) '카카오톡 윈도우 핸들 값을 Handle에 저장
    
    Application.Wait Now + TimeValue("0:00:01")
    '//찾지 못하면 에러 메세지 출력
    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 Target)
        Application.Wait Now + TimeValue("0:00:01")
        Call PostMessage(HandleEx, WM_KEYDOWN, VK_RETURN, 0)
        Application.Wait Now + TimeValue("0:00:01")
    End If
    
End Sub


' Get chat content
Private Function CopyChatroom(ByVal chatroom_name As String) As String
    Dim hwndMain As Long, hwndListControl As Long
    Dim ctext As String
    Dim dataObj As MSForms.DataObject ' Requires "Microsoft Forms 2.0 Object Library" reference
    
    hwndMain = FindWindow(vbNullString, chatroom_name)
    hwndListControl = FindWindowEx(hwndMain, 0, "EVA_VH_ListControl_Dblclk", vbNullString)
    
    ' Combination key, copy text to clipboard ( ctl + c , v )
'    PostKeyEx hwndListControl, Asc("A"), VK_CONTROL, False
'    Application.Wait Now + TimeValue("0:00:01")
'    PostKeyEx hwndListControl, Asc("C"), VK_CONTROL, False
'    Application.Wait Now + TimeValue("0:00:01")
    
    ' Ctrl 입력
    keybd_event VK_CONTROL, 0, 0, 0
    ' 딜레이
    Application.Wait Now + TimeValue("0:00:01")
    ' A 입력
    Call PostMessage(hwndListControl, WM_KEYDOWN, VK_A, 0)
    ' 딜레이
    Application.Wait Now + TimeValue("0:00:01")
    ' C 입력
    Call PostMessage(hwndListControl, WM_KEYDOWN, VK_C, 0)
    ' 딜레이
    Application.Wait Now + TimeValue("0:00:01")
    ' Ctrl키 올림
    keybd_event VK_CONTROL, 0, KEYEVENTF_KEYUP, 0
    
    Set dataObj = New MSForms.DataObject
    dataObj.GetFromClipboard
    ctext = dataObj.GetText
    
    CopyChatroom = ctext

    Call PostMessage(hwndListControl, WM_KEYDOWN, VK_ESC, 0)
End Function


Private Function GetTodayChat(cdata As String) As String
    
    Dim Today As String
    Dim i As Integer
    Dim j As Integer
    Dim lines As Variant
    
    Today = CStr(Format(Date, "yyyy년 m월 d일 aaaa"))
    
    '엔터로 구분해서 배열에 넣기
    lines = Split(cdata, vbCrLf)
    
    For i = 0 To UBound(lines)
        If InStr(lines(i), Today) > 0 Then
            ' 현재 날짜와 일치하면 다음 날짜의 내용부터 B 변수에 추가
            For j = i + 1 To UBound(lines)
                If lines(j) <> "" Then
                    GetTodayChat = GetTodayChat & lines(j) & vbCrLf
                End If
            Next j
            
            If Right(GetTodayChat, Len(vbCrLf)) = vbCrLf Then
                GetTodayChat = Left(GetTodayChat, Len(GetTodayChat) - Len(vbCrLf))
            End If
            Exit For
        End If
    Next i
    
End Function


Private Sub KakaoMessageFiltering(msg As String)

    Dim i As Long, j As Long                                    '반복구문에 사용할 변수
    Dim strU As String, strUF As String                           '문자를 합쳐갈(U)nion 변수
    Dim strEach$, strK$, strL$                                   '문자를 넣을 변수
    Dim varS() As String                             '전체영역을 넣기위한 variant형 string 변수
    Dim r As Integer, c As Integer
    Dim YN As VbMsgBoxResult
    Dim lines As Variant
    Dim k As Long
   
    Application.ScreenUpdating = False                  '화면 업데이트 (일시) 정지
   
    If Range("A1") <> "" Then                         '기존 데이터가 있다면
        Range("A1", Cells(Rows.Count, "O")).ClearContents '기존 데이터 삭제
    End If
    
    '엔터로 구분해서 배열에 넣기
    lines = Split(msg, vbCrLf)
    
    r = 1: c = 1    '시작지점
    
    For k = 0 To UBound(lines)
        strU = Split(lines(k), "]")(2)               '2번째 "]" 뒤의 문자를 변수에
        strUF = Replace(Trim(strU), ".", " ")            '앞뒤 공백과 .을 제거하고 변수에 넣음
        strUF = Replace(strUF, ",", " ")           ' ,을 제거하고 변수에 넣음
    
        varS = Split(strUF, " ")                        'B셀을 공백으로 쪼개서 배열에 넣음
    
        For i = LBound(varS) To UBound(varS)            '배열 하한선에서 상한선까지 반복
            If varS(i) <> "" Then                       '공백이 아닐경우
                For j = 1 To Len(varS(i))               '배열의 글자수만큼 반복
                    strEach = Mid(varS(i), j, 1)        '배열의 각 문자를 변수에 넣음
                    
                    If strEach Like "[a-zA-Z가-힣()]" Then           '한글&영어만 추출
                        Do                                         '실행
                            strK = strK & Mid(varS(i), j, 1)       '추출한 문자를 합쳐감
                            j = j + 1                              '문자위치 1씩 늘려감
                        Loop Until Not Mid(varS(i), j, 1) Like "[a-zA-Z가-힣()]" '지정문자 아닐때까지 반복
                        
                        '"키로"를 "kg"으로 변환
                        If strK = "키로" Then
                            Cells(r, c) = "kg"
                        ElseIf strK = "그람" Then
                            Cells(r, c) = "g"
                        Else
                            Cells(r, c) = strK
                        End If
                        
                        '"만원" or "천원"일 경우
                        If strK = "만원" Or strK = "천원" Or strK = "원" Then
                            Cells(r, c - 2).Value = CStr(Cells(r, c - 2)) + "(" + CStr(Cells(r, c - 1)) + strK + ")"
                            Cells(r, c - 1) = 1
                            Cells(r, c) = "봉"
                        End If
                        
                        c = c + 1
                    ElseIf strEach Like "[0-9]" Then                     '숫자만 추출
                        Do                                         '실행
                            strK = strK & Mid(varS(i), j, 1)       '추출한 숫자를 합쳐감
                            j = j + 1                              '문자위치 1씩 늘려감
                        Loop Until Not Mid(varS(i), j, 1) Like "[0-9]" '숫자가 아닐때까지 반복
                        
                        Cells(r, c) = strK
                        c = c + 1
                        Cells(r, c + 1) = "추가"
                    Else
                        MsgBox "잘못된 문자열이 포함되어 있습니다. (" & strEach & ")", vbCritical
                        Exit Sub
                    End If
                    j = j - 1
                    strK = ""       '초기화
                Next j
                r = r + 1
                c = 1
            End If
        Next i
    Next k
    
End Sub


Public Sub getChatData()

    Call Get_Kakao("대화방이름") '여기에 대화방 이름이 들어갑니다.

End Sub