일반 모듈에 사용된 VBA 코드
Function CleanInput(sText) As String
'###############################################################
'2022.12.17 오빠두엑셀 토요Live 119강
'▶ CleanInput
'문장에서 모든 줄바꿈을 제거하고, 큰따옴표(") 를 작은따옴표(')로 변환합니다.
'###############################################################
Dim sResult As String
sResult = Replace(sText, Chr(10), " ")
sResult = Replace(sResult, Chr(13), " ")
sResult = Replace(sResult, vbCrLf, " ")
sResult = Replace(sResult, vbNewLine, " ")
sResult = Replace(sResult, """", "'")
Do While InStr(1, sResult, " ") > 0
sResult = Replace(sResult, " ", " ")
Loop
CleanInput = Trim(sResult)
End Function
Function ClovaSummary(Content, Optional Model = "general", Optional summaryCount As Long = 3, Optional Tone As Long = 0, Optional Title, Optional Language As String = "ko")
'###############################################################
'2022.12.17 오빠두엑셀 토요Live 119강
'▶ ClovaSummary
'네이버 클로바 AI, 문장 요약 API로 호출된 결과값을 반환합니다.
'▶ 사용된 인수에 대한 자세한 설명은 아래 링크를 참고하세요.
'https://api.ncloud-docs.com/docs/ai-naver-clovasummary-api
'###############################################################
'-----------------------------------------
' ① 변수 선언
'-----------------------------------------
Dim result As Variant
Dim arr_Header As Variant
Dim sBody As String
Dim sResult As String
Dim vResult As Variant
Dim i As Long
Dim sKey As String: sKey = Sheet1.Range("B23").Value '<- API Key가 작성된 셀
Dim sSecret As String: sSecret = Sheet1.Range("B26").Value '<- API Secret이 작성된 셀
ReDim arr_Header(0 To 2)
arr_Header(0) = Array("X-NCP-APIGW-API-KEY-ID", sKey)
arr_Header(1) = Array("X-NCP-APIGW-API-KEY", sSecret)
arr_Header(2) = Array("Content-Type", "application/json")
'-----------------------------------------
' ② API 호출에 사용될 body 구문 작성
'-----------------------------------------
Dim sTitle As String 'optional
Dim sContent As String 'mandatory
Dim sModel As String 'optional
Dim sTone As String ' optional
Dim sCount As String ' optional
Dim sLanguage As String 'mandatory
If Not IsMissing(Title) Then sTitle = """title"": """ & Title & ""","
sContent = """content"": """ & Content & """"
sLanguage = """language"": """ & Language & ""","
sModel = """model"": """ & Model & ""","
sTone = """tone"": " & Tone & ","
sCount = """summaryCount"": " & summaryCount & ""
sBody = "{""document"":{" & sTitle & sContent & "},""option"":{" & sLanguage & sModel & sTone & sCount & "}}"
'-----------------------------------------
' ③ Clova AI 문장요약 AI 호출 / 결과값 가공
'-----------------------------------------
Set result = GetHttp("https://naveropenapi.apigw.ntruss.com/text-summary/v1/summarize", sBody, , arr_Header, , "POST")
sResult = result.body.innerhtml
sResult = Splitter(sResult, "summary"":""", """}")
vResult = Split(sResult, "\n")
ClovaSummary = Application.WorksheetFunction.Transpose(vResult)
End Function
Function GetHttp(URL As String, Optional formText As String, _
Optional isWinHttp As Boolean = False, _
Optional RequestHeader As Variant, _
Optional includeMeta As Boolean = False, _
Optional RequestType As String = "GET") As Object
'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ GetHttp 함수
'▶ 웹에서 데이터를 받아옵니다.
'▶ 인수 설명
'_____________URL : 데이터를 스크랩할 웹 페이지 주소입니다.
'_____________formText : Encoding 된 FormText 형식으로 보내야 할 경우, Send String에 쿼리문을 추가합니다.
'_____________isWinHttp : WinHTTP 로 요청할지 여부입니다. Redirect가 필요할 경우 True로 입력하여 WinHttp 요청을 전송합니다.
'_____________RequestHeader : RequestHeader를 배열로 입력합니다. 반드시 짝수(한 쌍씩 이루어진) 개수로 입력되어야 합니다.
'_____________includeMeta : TRUE 일 경우 HTML 문서위로 ResponseText를 강제 입력합니다. Meta값이 포함되어 HTML이 작성되며 innerText를 사용할 수 없습니다. 기본값은 False 입니다.
'_____________RequestType : 요청방식입니다. 기본값은 "GET"입니다.
'▶ 사용 예제
'Dim HtmlResult As Object
'Set htmlResult = GetHttp("https://www.naver.com")
'msgbox htmlResult.body.innerHTML
'###############################################################
Dim oHTMLDoc As Object: Dim objHTTP As Object
Dim HTMLDoc As Object
Dim i As Long: Dim blnAgent As Boolean: blnAgent = False
Dim sUserAgent As String: sUserAgent = "Mozilla/5.0 (Linux; Android 6.0; Nexus 5 Build/MRA58N) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.183 Mobile Safari/537.36"
Application.DisplayAlerts = False
If Left(URL, 4) <> "http" Then URL = "http://" & URL
Set oHTMLDoc = CreateObject("HtmlFile")
Set HTMLDoc = CreateObject("HtmlFile")
If isWinHttp = False Then
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
Else
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
End If
objHTTP.setTimeouts 3000, 3000, 3000, 3000
objHTTP.Open RequestType, URL, False
If Not IsMissing(RequestHeader) Then
Dim vRequestHeader As Variant
For Each vRequestHeader In RequestHeader
Dim uHeader As Long: Dim Lheader As Long: Dim steps As Long
uHeader = UBound(vRequestHeader): Lheader = LBound(vRequestHeader)
If (uHeader - Lheader) Mod 2 = 0 Then GetHttp = CVErr(xlValue): Exit Function
For i = Lheader To uHeader Step 2
If vRequestHeader(i) = "User-Agent" Then blnAgent = True
objHTTP.setRequestHeader vRequestHeader(i), vRequestHeader(i + 1)
Next
Next
End If
If blnAgent = False Then objHTTP.setRequestHeader "User-Agent", sUserAgent
objHTTP.send formText
If includeMeta = False Then
With oHTMLDoc
.Open
.Write objHTTP.responseText
.Close
End With
Else
oHTMLDoc.body.innerhtml = objHTTP.responseText
End If
Set GetHttp = oHTMLDoc
Set oHTMLDoc = Nothing
Set objHTTP = Nothing
Application.DisplayAlerts = True
End Function
Function Splitter(v As Variant, Cutter As String, Optional Trimmer As String)
'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ Splitter 함수
'▶ Cutter ~ Timmer 사이의 문자를 추출합니다. (Timmer가 빈칸일 경우 Cutter 이후 문자열을 추출합니다.)
'▶ 인수 설명
'_____________v : 문자열입니다.
'_________Cutter : 문자열 절삭을 시작할 텍스트입니다.
'_________Trimmer : 문자열 절삭을 종료할 텍스트입니다. (선택인수)
'▶ 사용 예제
'Dim s As String
's = "{sa;b132@drama#weekend;aabbcc"
's = Splitter(s, "@", "#")
'msgbox s '--> "drama"를 반환합니다.
'###############################################################
Dim vaArr As Variant
On Error GoTo EH:
vaArr = Split(v, Cutter)(1)
If Not IsMissing(Trimmer) Then vaArr = Split(vaArr, Trimmer)(0)
Splitter = vaArr
Exit Function
EH:
Splitter = ""
End Function
Visual Basic
복사
시트 모듈에 사용한 VBA 코드
Private Sub Worksheet_Change(ByVal Target As Range)
Dim inputRng As Range
Dim sInput As String
Set inputRng = Range("C4")
Application.EnableEvents = False
If Not Intersect(Target, inputRng) Is Nothing Then
sInput = inputRng.Value
If Len(inputRng.Value) > 2000 Then
MsgBox "입력한 문장이 최대값인 2,000자를 초과하여, 2,000자 이후 문장은 제외됩니다."
sInput = Left(sInput, 2000)
sInput = Left(sInput, InStrRev(sInput, "."))
End If
inputRng.Value = CleanInput(sInput)
inputRng.EntireRow.AutoFit
End If
Application.EnableEvents = True
End Sub
Visual Basic
복사