通过 Excel 和 VBA 结合金蝶 API 实现登录金蝶云星空。

1、准备工作：

• 确保你已经拥有金蝶的API文档，以及相关的API接口信息，通常可以从金蝶官方网站或你的金蝶系统管理员获取。

• 在 Excel 中开启开发者选项，以便使用VBA。

2、VBA环境配置：

• 打开 Excel，按 Alt + F11 进入VBA编辑器。

• 在 VBA 编辑器中，插入一个新的模块 (Insert > Module)。

3、编写VBA代码：

• 使用下面的代码示例来进行金蝶登录。

Public isLoggedIn As Boolean ' 登录状态标志变量

Public authCookies As String ' 全局变量，保存 cookies 信息，用于其他模块调用

Public Pbpassword As String

Sub HandleLogin()

    Dim username As String

    Dim password As String

    Dim loginUrl As String

    Dim acctid As String

    Dim lcid As Long

    Dim jsonResponse As Object

    Dim loginResultType As Long

    Dim attemptCount As Long

    ' 显示UserForm以获取输入

    If isLoggedIn = True Then

        UserForm1.Hide

        MsgBox "已经登录，无须再登录！"

        Exit Sub

    Else

        UserForm1.Show

    End If

    isLoggedIn = False ' 更新登录状态

   ' 获取输入的用户名和密码

    username = "your_username"  ' 替换为你的用户名

    password = "your_password"  ' 替换为你的密码

    Pbpassword = password ' 临时存储密码

    ' 设置登录信息

    acctid = "你的金蝶ID"

    lcid = 2052

    loginUrl = "https://你的金蝶API地址/login"

    ' 创建 JSON 数据

    Dim jsonData As String

    jsonData = "{""acctid"":""" & acctid & """," _

              & """username"":""" & username & """," _

              & """password"":""" & password & """," _

              & """lcid"":" & lcid & "}"

    ' 发送 HTTP POST 请求并获取响应

    Set jsonResponse = JsonConverter.ParseJson(PostRequest(loginUrl, jsonData))

    ' 读取 LoginResultType 变量的值

    loginResultType = jsonResponse("LoginResultType")

    If loginResultType = 1 Then

        MsgBox "登录成功！"

        isLoggedIn = True ' 更新登录状态

        ' Call Workbook_BeforeClose   '删除工作表

        ' 这里可以添加后续成功登录后的处理代码

    Else

        attemptCount = attemptCount + 1

        If attemptCount >= 3 Then

            MsgBox "登录失败次数过多，程序将退出。"

            ' 退出程序的处理代码

        Else

            MsgBox "登录失败，请重试。"

        End If

        isLoggedIn = False ' 更新登录状态

    End If

End Sub

Function PostRequest(url As String, jsonData As String) As String

    Dim http As Object

    Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")

    On Error GoTo ErrorHandler

    http.Open "POST", url, False

    http.setRequestHeader "Content-Type", "application/json"

    http.send jsonData

    ' 获取 cookies 并保存到全局变量

    authCookies = http.getResponseHeader("Set-Cookie")

    PostRequest = http.responseText

    Exit Function

ErrorHandler:

    PostRequest = "错误: " & Err.Description

End Function