엑셀 ↔ 구글시트 연동 코드

// 엑셀퀘스트: 값만 주고받는 고정 범위 API
const SPREADSHEET_ID = 'PASTE_YOUR_SPREADSHEET_ID';
const SHEET_NAME = '게임목록';
const SYNC_RANGE = 'A1:D20';
const ACCESS_KEY = 'CHANGE_TO_YOUR_OWN_LONG_KEY';

function doGet(e) {
  try {
    checkKey(e.parameter.key);
    if (e.parameter.action !== 'read') throw new Error('action은 read여야 합니다.');
    const range = getRange();
    const values = range.getValues().map(row => row.map(value =>
      value instanceof Date ? value.toISOString() : value));
    return reply({ok: true, values: values});
  } catch (error) {
    return reply({ok: false, error: error.message});
  }
}

function doPost(e) {
  const lock = LockService.getScriptLock();
  try {
    const body = JSON.parse(e.postData.contents);
    checkKey(body.key);
    if (body.action !== 'write') throw new Error('action은 write여야 합니다.');
    if (!lock.tryLock(10000)) throw new Error('다른 요청이 처리 중입니다.');
    const range = getRange();
    const values = body.values;
    if (!Array.isArray(values) || values.length !== range.getNumRows() ||
        values.some(row => !Array.isArray(row) || row.length !== range.getNumColumns())) {
      throw new Error('양쪽 SYNC_RANGE의 행과 열 개수를 맞춰주세요.');
    }
    const safeValues = values.map(row => row.map(value => {
      if (value === null) return '';
      if (typeof value === 'string') return value === '' ? '' : "'" + value;
      if (typeof value === 'number' && Number.isFinite(value)) return value;
      if (typeof value === 'boolean') return value;
      throw new Error('지원하지 않는 셀 값입니다.');
    }));
    range.setValues(safeValues);
    SpreadsheetApp.flush();
    return reply({ok: true, message: '저장 완료'});
  } catch (error) {
    return reply({ok: false, error: error.message});
  } finally {
    if (lock.hasLock()) lock.releaseLock();
  }
}

function checkKey(key) {
  if (ACCESS_KEY === 'CHANGE_TO_YOUR_OWN_LONG_KEY' || key !== ACCESS_KEY) {
    throw new Error('접근 키를 확인해주세요.');
  }
}

function getRange() {
  const sheet = SpreadsheetApp.openById(SPREADSHEET_ID).getSheetByName(SHEET_NAME);
  if (!sheet) throw new Error('시트 이름을 확인해주세요.');
  return sheet.getRange(SYNC_RANGE);
}

function reply(data) {
  return ContentService.createTextOutput(JSON.stringify(data))
    .setMimeType(ContentService.MimeType.JSON);
}

Option Explicit

Private Const WEB_APP_URL As String = "PASTE_YOUR_WEB_APP_URL"
Private Const ACCESS_KEY As String = "CHANGE_TO_YOUR_OWN_LONG_KEY"
Private Const LOCAL_SHEET As String = "연동"
Private Const SYNC_RANGE As String = "A1:D20"

Public Sub 가져오기()
    On Error GoTo Failed
    Dim result As Object, rows As Object, row As Object
    Dim target As Range, r As Long, c As Long, v As Variant
    Set target = ThisWorkbook.Worksheets(LOCAL_SHEET).Range(SYNC_RANGE)
    Set result = Request("GET", WEB_APP_URL & "?action=read&key=" & _
        Application.WorksheetFunction.EncodeURL(ACCESS_KEY), "")
    Set rows = result("values")
    If rows.Count <> target.rows.Count Then Err.Raise 5, , "양쪽 범위의 행 개수를 맞춰주세요."
    For r = 1 To rows.Count
        Set row = rows(r)
        If row.Count <> target.Columns.Count Then Err.Raise 5, , "양쪽 범위의 열 개수를 맞춰주세요."
    Next r
    Application.ScreenUpdating = False
    For r = 1 To rows.Count
        Set row = rows(r)
        For c = 1 To row.Count
            v = row(c)
            If IsNull(v) Then v = ""
            With target.Cells(r, c)
                If VarType(v) = vbString Then
                    .NumberFormat = "@"
                Else
                    .NumberFormat = "General"
                End If
                .Value2 = v
            End With
        Next c
    Next r
    Application.ScreenUpdating = True
    MsgBox "가져오기 완료", vbInformation
    Exit Sub
Failed:
    Application.ScreenUpdating = True
    MsgBox Err.Description, vbExclamation
End Sub

Public Sub 보내기()
    On Error GoTo Failed
    Dim target As Range, result As Object, body As String
    Set target = ThisWorkbook.Worksheets(LOCAL_SHEET).Range(SYNC_RANGE)
    If MsgBox("구글시트의 " & SYNC_RANGE & "을 현재 엑셀 값으로 덮어씁니다. 빈칸도 전송합니다.", _
        vbOKCancel + vbQuestion) <> vbOK Then Exit Sub
    body = "{""action"":""write"",""key"":" & QuoteJson(ACCESS_KEY) & _
        ",""values"":" & MatrixJson(target) & "}"
    Set result = Request("POST", WEB_APP_URL, body)
    MsgBox "보내기 완료", vbInformation
    Exit Sub
Failed:
    MsgBox Err.Description, vbExclamation
End Sub

Private Function Request(ByVal method As String, ByVal url As String, ByVal body As String) As Object
    Dim http As Object, result As Object, text As String, p As Long
    If InStr(WEB_APP_URL, "https://script.google.com/macros/s/") <> 1 Then _
        Err.Raise 5, , "WEB_APP_URL에 /exec 배포 주소를 넣어주세요."
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    http.SetTimeouts 15000, 15000, 30000, 60000
    http.Open method, url, False
    If method = "POST" Then
        http.SetRequestHeader "Content-Type", "application/json; charset=utf-8"
        http.Send Utf8Bytes(body)
    Else
        http.Send
    End If
    If http.Status <> 200 Then Err.Raise 5, , "HTTP 오류: " & http.Status
    text = http.ResponseText
    If Left$(LTrim$(text), 1) <> "{" Then Err.Raise 5, , "JSON 응답이 아닙니다. 배포 주소와 접근 권한을 확인해주세요."
    p = 1
    Set result = JsonValue(text, p)
    If Not result.Exists("ok") Then Err.Raise 5, , "응답 형식을 확인해주세요."
    If Not result("ok") Then Err.Raise 5, , CStr(result("error"))
    Set Request = result
End Function

Private Function Utf8Bytes(ByVal text As String) As Variant
    Dim stream As Object
    Set stream = CreateObject("ADODB.Stream")
    stream.Type = 2
    stream.Charset = "utf-8"
    stream.Open
    stream.WriteText text
    stream.Position = 0
    stream.Type = 1
    stream.Position = 3
    Utf8Bytes = stream.Read
    stream.Close
End Function

Private Function MatrixJson(ByVal cells As Range) As String
    Dim r As Long, c As Long, text As String, v As Variant
    text = "["
    For r = 1 To cells.rows.Count
        If r > 1 Then text = text & ","
        text = text & "["
        For c = 1 To cells.Columns.Count
            If c > 1 Then text = text & ","
            v = cells.Cells(r, c).Value2
            If IsError(v) Then Err.Raise 5, , "오류가 있는 셀을 먼저 수정해주세요."
            Select Case VarType(v)
                Case vbEmpty: text = text & "null"
                Case vbBoolean: text = text & LCase$(CStr(v))
                Case vbByte, vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbDecimal
                    text = text & Trim$(Str$(v))
                Case Else: text = text & QuoteJson(CStr(v))
            End Select
        Next c
        text = text & "]"
    Next r
    MatrixJson = text & "]"
End Function

Private Function QuoteJson(ByVal text As String) As String
    Dim i As Long, n As Long, ch As String, result As String
    result = Chr$(34)
    For i = 1 To Len(text)
        ch = Mid$(text, i, 1)
        n = AscW(ch) And &HFFFF&
        Select Case n
            Case 34: result = result & "\" & Chr$(34)
            Case 92: result = result & "\\"
            Case 0 To 31: result = result & "\u" & Right$("0000" & Hex$(n), 4)
            Case Else: result = result & ch
        End Select
    Next i
    QuoteJson = result & Chr$(34)
End Function

Private Sub WhiteSpace(ByVal text As String, ByRef p As Long)
    Do While p <= Len(text)
        If InStr(1, " " & vbTab & vbCr & vbLf, Mid$(text, p, 1), vbBinaryCompare) = 0 Then Exit Do
        p = p + 1
    Loop
End Sub

Private Function JsonValue(ByVal text As String, ByRef p As Long) As Variant
    Dim ch As String, key As String, obj As Object, item As Variant, start As Long
    WhiteSpace text, p
    ch = Mid$(text, p, 1)
    Select Case ch
        Case "{"
            Set obj = CreateObject("Scripting.Dictionary")
            p = p + 1
            WhiteSpace text, p
            If Mid$(text, p, 1) <> "}" Then
                Do
                    WhiteSpace text, p
                    key = JsonString(text, p)
                    WhiteSpace text, p
                    If Mid$(text, p, 1) <> ":" Then Err.Raise 5, , "JSON 구문 오류"
                    p = p + 1
                    obj.Add key, JsonValue(text, p)
                    WhiteSpace text, p
                    ch = Mid$(text, p, 1)
                    If ch = "}" Then Exit Do
                    If ch <> "," Then Err.Raise 5, , "JSON 구문 오류"
                    p = p + 1
                Loop
            End If
            p = p + 1
            Set JsonValue = obj
        Case "["
            Set obj = New Collection
            p = p + 1
            WhiteSpace text, p
            If Mid$(text, p, 1) <> "]" Then
                Do
                    obj.Add JsonValue(text, p)
                    WhiteSpace text, p
                    ch = Mid$(text, p, 1)
                    If ch = "]" Then Exit Do
                    If ch <> "," Then Err.Raise 5, , "JSON 구문 오류"
                    p = p + 1
                Loop
            End If
            p = p + 1
            Set JsonValue = obj
        Case Chr$(34): JsonValue = JsonString(text, p)
        Case "t"
            If Mid$(text, p, 4) <> "true" Then Err.Raise 5, , "JSON 구문 오류"
            JsonValue = True: p = p + 4
        Case "f"
            If Mid$(text, p, 5) <> "false" Then Err.Raise 5, , "JSON 구문 오류"
            JsonValue = False: p = p + 5
        Case "n"
            If Mid$(text, p, 4) <> "null" Then Err.Raise 5, , "JSON 구문 오류"
            JsonValue = Null: p = p + 4
        Case Else
            start = p
            Do While p <= Len(text)
                If InStr(1, "-+0123456789.eE", Mid$(text, p, 1), vbBinaryCompare) = 0 Then Exit Do
                p = p + 1
            Loop
            If p = start Then Err.Raise 5, , "JSON 구문 오류"
            JsonValue = Val(Mid$(text, start, p - start))
    End Select
End Function

Private Function JsonString(ByVal text As String, ByRef p As Long) As String
    Dim result As String, ch As String, n As Long
    If Mid$(text, p, 1) <> Chr$(34) Then Err.Raise 5, , "JSON 문자열 오류"
    p = p + 1
    Do While p <= Len(text)
        ch = Mid$(text, p, 1): p = p + 1
        If ch = Chr$(34) Then
            JsonString = result
            Exit Function
        End If
        If ch = "\" Then
            ch = Mid$(text, p, 1): p = p + 1
            Select Case ch
                Case "n": ch = vbLf
                Case "r": ch = vbCr
                Case "t": ch = vbTab
                Case "b": ch = Chr$(8)
                Case "f": ch = Chr$(12)
                Case "u"
                    n = CLng("&H" & Mid$(text, p, 4))
                    If n > 32767 Then n = n - 65536
                    ch = ChrW$(n): p = p + 4
                Case "\", "/", Chr$(34)
                Case Else: Err.Raise 5, , "JSON 이스케이프 오류"
            End Select
        End If
        result = result & ch
    Loop
    Err.Raise 5, , "JSON 문자열이 끝나지 않았습니다."
End Function