使用G-Suite时，无需公开Google Sheets即可通过VBA导入至Excel的方案问询

一、原QueryTable方法能否在组权限下使用？ #

不行。原代码通过匿名HTTP请求获取Google Sheets的HTML导出数据，当权限设为“此组内任何拥有链接的人可查看”时，Google会要求请求携带有效的身份验证信息（如登录状态Cookie或OAuth令牌），但QueryTable的URL请求是匿名的，无法通过权限校验，会返回权限错误，无法获取数据。

二、替代方案 #

方案1：使用Google Sheets API + VBA（推荐G-Suite环境） #

通过Google Sheets API完成身份验证后访问数据，无需公开表格权限，只需给G-Suite内的服务账号或用户授权即可。

步骤：

1. 在Google Cloud Console创建项目，启用Google Sheets API。
2. 创建服务账号，生成JSON格式密钥文件，提取其中的client_email、private_key信息。
3. 在Google Sheets中，将服务账号邮箱添加为表格查看者（权限设为“此组内可查看”即可，服务账号属于G-Suite域内时直接生效）。

VBA代码示例（需先导入Microsoft Scripting Runtime和Microsoft XML, v6.0引用）：

Sub ImportSheetsViaAPI()
    Dim serviceEmail As String, privateKey As String, spreadsheetId As String, rangeStr As String
    Dim jwtToken As String, apiUrl As String, xmlHttp As Object, responseText As String
    Dim jsonObj As Object, rows As Variant, i As Integer, j As Integer
    
    ' 替换为你的服务账号信息和表格信息
    serviceEmail = "your-service-account@project-id.iam.gserviceaccount.com"
    privateKey = "-----BEGIN PRIVATE KEY-----你的私钥-----END PRIVATE KEY-----"
    spreadsheetId = "1ldBURfb1mWJy-BfzHF_zMQawRyXKHUhJkOHvnsWno3o"
    rangeStr = "Sheet1!A:Z" ' 要导入的范围
    
    ' 获取JWT令牌（用于API身份验证）
    jwtToken = GetJwtToken(serviceEmail, privateKey)
    
    ' 调用Sheets API获取数据
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
    apiUrl = "https://sheets.googleapis.com/v4/spreadsheets/" & spreadsheetId & "/values/" & rangeStr
    xmlHttp.Open "GET", apiUrl, False
    xmlHttp.SetRequestHeader "Authorization", "Bearer " & jwtToken
    xmlHttp.Send
    
    If xmlHttp.Status = 200 Then
        ' 解析JSON响应
        Set jsonObj = ParseJson(xmlHttp.responseText)
        rows = jsonObj("values")
        
        ' 清空当前工作表并写入数据
        ActiveSheet.Cells.Clear
        For i = LBound(rows) To UBound(rows)
            For j = LBound(rows(i)) To UBound(rows(i))
                ActiveSheet.Cells(i + 1, j + 1).Value = rows(i)(j)
            Next j
        Next i
    Else
        MsgBox "API请求失败：" & xmlHttp.Status & " - " & xmlHttp.statusText
    End If
End Sub

' 生成JWT令牌的辅助函数
Function GetJwtToken(serviceEmail As String, privateKey As String) As String
    Dim header As String, payload As String, jwtParts As String, signedData As String
    Dim sha256 As Object, privateKeyObj As Object
    
    ' JWT头部和载荷
    header = "{""alg"":""RS256"",""typ"":""JWT""}"
    payload = "{""iss"":""" & serviceEmail & """,""scope"":""https://www.googleapis.com/auth/spreadsheets.readonly"",""aud"":""https://oauth2.googleapis.com/token"",""exp"":" & Round(Now() * 86400 + 3600) & ",""iat"":" & Round(Now() * 86400) & "}"
    
    ' 编码头部和载荷为Base64URL格式
    header = Base64UrlEncode(EncodeUTF8(header))
    payload = Base64UrlEncode(EncodeUTF8(payload))
    jwtParts = header & "." & payload
    
    ' 使用私钥签名
    Set sha256 = CreateObject("System.Security.Cryptography.SHA256Managed")
    Set privateKeyObj = CreateObject("System.Security.Cryptography.RSACryptoServiceProvider")
    privateKeyObj.FromXmlString(PemToXml(privateKey))
    
    signedData = Base64UrlEncode(privateKeyObj.SignData(EncodeUTF8(jwtParts), sha256))
    
    GetJwtToken = jwtParts & "." & signedData
End Function

' 辅助函数：PEM私钥转XML格式
Function PemToXml(pemKey As String) As String
    Dim pemClean As String
    pemClean = Replace(Replace(pemKey, "-----BEGIN PRIVATE KEY-----", ""), "-----END PRIVATE KEY-----", "")
    pemClean = Replace(pemClean, vbCrLf, "")
    PemToXml = "<RSAKeyValue>" & Base64Decode(pemClean) & "</RSAKeyValue>"
End Function

' 辅助函数：UTF8编码
Function EncodeUTF8(text As String) As Byte()
    Dim utf8 As Object
    Set utf8 = CreateObject("System.Text.UTF8Encoding")
    EncodeUTF8 = utf8.GetBytes_4(text)
End Function

' 辅助函数：Base64URL编码
Function Base64UrlEncode(data As Byte()) As String
    Dim base64 As String
    base64 = EncodeBase64(data)
    Base64UrlEncode = Replace(Replace(Replace(base64, "+", "-"), "/", "_"), "=", "")
End Function

' 辅助函数：Base64编码
Function EncodeBase64(data As Byte()) As String
    Dim objXML As Object, objNode As Object
    Set objXML = CreateObject("MSXML2.DOMDocument")
    Set objNode = objXML.createElement("b64")
    objNode.DataType = "bin.base64"
    objNode.nodeTypedValue = data
    EncodeBase64 = objNode.Text
End Function

' 辅助函数：Base64解码
Function Base64Decode(text As String) As String
    Dim objXML As Object, objNode As Object
    Set objXML = CreateObject("MSXML2.DOMDocument")
    Set objNode = objXML.createElement("b64")
    objNode.DataType = "bin.base64"
    objNode.Text = text
    Base64Decode = objNode.nodeTypedValue
End Function

方案2：使用Power Query（Get & Transform） #

Excel内置的Power Query支持通过身份验证访问私有Google Sheets，无需公开权限，操作简单：

1. 打开Excel，点击数据>获取数据>从其他来源>从Web。
2. 输入Google Sheets的CSV导出链接（将表格编辑链接中的edit#gid=0替换为export?format=csv&gid=0）。
3. 在弹出的访问窗口中，选择Google账号登录（需是G-Suite组内有权限的账号），完成验证后即可加载数据。
4. 可设置数据刷新频率，或用以下VBA代码触发刷新：

Sub RefreshPowerQuery()
    ThisWorkbook.Connections("Query - 你的查询名称").Refresh
End Sub

方案3：使用Google Apps Script同步数据 #

如果允许定期同步，可在Google Sheets中编写Apps Script，将数据导出为Excel格式文件并保存到G-Suite共享驱动器，再通过Excel打开该文件：

function syncToExcel() {
    var spreadsheet = SpreadsheetApp.getActiveSpreadsheet();
    var sheet = spreadsheet.getSheetByName("Sheet1");
    var data = sheet.getDataRange().getValues();
    
    // 创建临时表格
    var tempSpreadsheet = SpreadsheetApp.create("SyncTemp");
    var tempSheet = tempSpreadsheet.getSheetByName("Sheet1");
    tempSheet.getRange(1, 1, data.length, data[0].length).setValues(data);
    
    // 导出为Excel格式并保存到共享驱动器
    var blob = tempSpreadsheet.getAs(MimeType.MICROSOFT_EXCEL);
    DriveApp.getFolderById("共享驱动器ID").createFile(blob).setName("SyncData.xlsx");
    
    // 删除临时表格
    DriveApp.getFileById(tempSpreadsheet.getId()).setTrashed(true);
}

设置定时触发器定期执行脚本后，Excel端只需打开共享驱动器中的文件即可获取最新数据。

内容的提问来源于stack exchange，提问作者Arfur