[ EXCEL VBA ]EXCEL-VBA-007 네이버 블러그 글쓰기 샘플

[ EXCEL VBA ]EXCEL-VBA-007 네이버 블러그 글쓰기 샘플

 

VBA 창에서 도구 → 참조 메뉴를 선택하여 Microsoft WinHTTP Services, version 5.1 항목에 체크 필요

Sub PostToNaverBlog()
    Dim url As String
    Dim apiKey As String
    Dim apiSecret As String
    Dim blogId As String
    Dim postId As String
    Dim title As String
    Dim content As String
    Dim category As String
    Dim tag As String
    Dim visibility As String
    Dim thumbnailUrl As String
    
    ' 네이버 블로그 API 설정
    url = "https://api.blog.naver.com"
    apiKey = "API Key"
    apiSecret = "API Secret"
    blogId = "블로그 ID"
    
    ' 게시물 정보 설정
    title = "게시물 제목"
    content = "게시물 내용"
    category = "카테고리 이름"
    tag = "태그1, 태그2"
    visibility = "0" ' 0: 전체공개, 1: 친구공개, 2: 비공개
    thumbnailUrl = "썸네일 이미지 URL"
    
    ' API 호출을 위한 HTTP 요청 객체 생성
    Dim request As Object
    Set request = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    ' HTTP 요청 설정
    request.Open "POST", url & "/post/" & blogId
    request.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
    request.SetRequestHeader "Authorization", "Bearer " & GetAccessToken(apiKey, apiSecret)
    
    ' HTTP 요청 바디 설정
    Dim requestBody As String
    requestBody = "title=" & title & "&content=" & content & "&categoryName=" & category & "&tag=" & tag & "&visibility=" & visibility & "&thumbnailUrl=" & thumbnailUrl
    request.Send requestBody
    
    ' HTTP 요청 결과 확인
    If request.Status = 200 Then
        MsgBox "게시물이 성공적으로 작성되었습니다."
    Else
        MsgBox "게시물 작성에 실패하였습니다. (" & request.Status & ")"
    End If
End Sub

Function GetAccessToken(apiKey As String, apiSecret As String) As String
    ' 네이버 블로그 API에서 액세스 토큰을 발급받는 함수
    
    Dim request As Object
    Set request = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    ' HTTP 요청 설정
    request.Open "POST", "https://nid.naver.com/oauth2.0/token"
    request.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
    ' HTTP 요청 바디 설정
    Dim requestBody As String
    requestBody = "grant_type=client_credentials&client_id=" & apiKey & "&client_secret=" & apiSecret
    request.Send requestBody
    
    ' HTTP 요청 결과 확인
    If request.Status = 200 Then
        ' 액세스 토큰 추출
        Dim responseText As String
        responseText = request.responseText
        Dim startIdx As Long
        startIdx = InStr(responseText
		Dim endIdx As Long
		endIdx = InStr(startIdx, responseText, """")
		GetAccessToken = Mid(responseText, startIdx, endIdx - startIdx)
	Else
		' 에러 처리
		MsgBox "액세스 토큰 발급에 실패하였습니다. (" & request.Status & ")"
	End If
	
End Function