오픈 ai 챗 gpt로 이미지를 첨부하고 물어보면 답을 해줍니다. 그런데 이미지가 여러 장이라면 하나하나 첨부하고 물어보고 정리하려면 너무 힘들겠지요. 이것을 자동으로 해주는 방법이 있습니다. ocr excel 을 VBA로 구현한 코드를 정리합니다.

챗GPT API와 ocr excel 로 명함 사진들 읽기

내 PC 폴더에 명함 사진들이 있습니다. 이 영수증의 아래 내용을 읽어 엑셀로 자동 정리해주는 코드입니다.

• 이름

• 직책

• 회사명

• 전화번호

• 이메일

엑셀에서 Alt+F11을 눌러 VBA Editor를 엽니다.

삽입/모듈 메뉴를 선택합니다.

아래 코드를 붙여 넣습니다.

JsonConverter.bas를 다운로드 받아둡니다.

파일/가져오기 메뉴를 눌러 JsonConverter.bas 파일을 불러옵니다.

도구/참조에 아래를 체크합니다.

• Microsoft Scripting Runtime

' 챗GPT API로 ocr excel 명함 자동 정리 Attribute VB_Name = "Module1"
Sub ProcessBusinessCards()

    ' OpenAI API 키 설정
    Dim apiKey As String
    apiKey = "API KEY를 여기 넣어주세요."

    ' 이미지 경로 설정
    Dim folderPath As String
    folderPath = "c:\ocrimg\"

    ' 파일 시스템 객체 생성
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim folder As Object
    Set folder = fso.GetFolder(folderPath)
    Dim file As Object

    ' 엑셀 워크시트 설정
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Dim row As Integer
    row = 2 ' 데이터 작성 시작 행

    ' 폴더의 각 이미지 파일에 대해 처리
    For Each file In folder.Files
        If LCase(fso.GetExtensionName(file.Name)) = "jpg" Or LCase(fso.GetExtensionName(file.Name)) = "jpeg" Or LCase(fso.GetExtensionName(file.Name)) = "png" Then
            ' 이미지를 base64로 인코딩하는 함수 호출
            Dim base64Image As String
            base64Image = EncodeImageToBase64(file.Path)
            
            ' OpenAI API 호출
            Dim response As String
            response = CallOpenAI(apiKey, base64Image)
            
            ' JSON 응답에서 필요한 정보 추출
            Dim jsonResponse As Dictionary
            Set jsonResponse = JsonConverter.ParseJson(response)
            
            Dim content As String
            content = jsonResponse("choices")(1)("message")("content")
            
            Dim name As String
            Dim position As String
            Dim companyName As String
            Dim phoneNumber As String
            Dim email As String
            
            name = ExtractValue(content, "이름:")
            position = ExtractValue(content, "직책:")
            companyName = ExtractValue(content, "회사명:")
            phoneNumber = ExtractValue(content, "전화번호:")
            email = ExtractValue(content, "이메일:")
            
            ' 결과 엑셀에 작성
            ws.Cells(row, 1).value = name
            ws.Cells(row, 2).value = position
            ws.Cells(row, 3).value = companyName
            ws.Cells(row, 4).value = phoneNumber
            ws.Cells(row, 5).value = email
            
            row = row + 1
        End If
    Next file
    
    ' 해제
    Set fso = Nothing
    Set folder = Nothing

End Sub

' 챗GPT API로 ocr excel 명함 자동 정리
Function ExtractValue(content As String, label As String) As String
    Dim startPos As Long
    Dim endPos As Long
    Dim value As String
    
    startPos = InStr(content, label) + Len(label)
    endPos = InStr(startPos, content, vbLf)
    
    If startPos > 0 And endPos > 0 Then
        value = Trim(Mid(content, startPos, endPos - startPos))
    Else
        value = ""
    End If
    
    ExtractValue = value
End Function

' 챗GPT API로 ocr excel 명함 자동 정리
Function EncodeImageToBase64(imagePath As String) As String
    ' 이미지를 base64로 인코딩하는 함수

    Dim inputStream As Object
    Set inputStream = CreateObject("ADODB.Stream")
    inputStream.Type = 1 ' adTypeBinary
    inputStream.Open
    inputStream.LoadFromFile imagePath

    Dim base64Stream As Object
    Set base64Stream = CreateObject("MSXML2.DOMDocument").createElement("Base64Data")
    base64Stream.DataType = "bin.base64"
    base64Stream.nodeTypedValue = inputStream.Read()

    EncodeImageToBase64 = Replace(base64Stream.Text, vbLf, "")

    inputStream.Close
    Set inputStream = Nothing
    Set base64Stream = Nothing
End Function

' 챗GPT API로 ocr excel 명함 자동 정리
Function CallOpenAI(apiKey As String, base64Image As String) As String
    ' OpenAI API 호출

    ' HTTP 요청을 보내기 위한 객체 생성
    Dim http As Object
    Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")

    ' API 엔드포인트 URL 설정
    Dim url As String
    url = "https://api.openai.com/v1/chat/completions"

    ' JSON 페이로드 설정
    Dim payload As String
    payload = "{""model"": ""gpt-4o"", ""messages"": [{""role"": ""user"", ""content"": [{""type"": ""text"", ""text"": ""이 명함에서 이름, 직책, 회사명, 전화번호, 이메일을 추출해줘.""},{""type"": ""image_url"", ""image_url"": {""url"": ""data:image/jpeg;base64," & base64Image & """}}]}], ""max_tokens"": 1000}"

    ' HTTP 요청 설정
    With http
        .Open "POST", url, False
        .SetRequestHeader "Content-Type", "application/json"
        .SetRequestHeader "Authorization", "Bearer " & apiKey
        .Send payload
    End With

    ' 응답 처리
    CallOpenAI = http.responseText
End Function

OpenAI API Key를 코드에 붙여 넣습니다.

엑셀로 돌아와 Alt+F8을 눌러 실행하면 엑셀 시트에 명함 내용이 정리되는 것이 확인됩니다.

Open AI API Vision
오픈 ai 챗 gpt 와 엑셀로 OCR하기