通过 Excel 和 VBA 结合金蝶 API 实现登录金蝶云星空。原创
金蝶云社区-FanShine
FanShine
4人赞赏了该文章 268次浏览 未经作者许可,禁止转载编辑于2024年11月05日 08:39:11

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


推荐:结合EXCEL、VBA、PYTHON与金蝶API构建高效数字化系统整合方案

图标赞 4
4人点赞
还没有人点赞,快来当第一个点赞的人吧!
图标打赏
0人打赏
还没有人打赏,快来当第一个打赏的人吧!