VBA中CredReadW读取Windows凭据管理器内Jira集成PAT失败的问题排查及解决方法求助
VBA中CredReadW读取Windows凭据管理器内Jira集成PAT失败的问题排查及解决方法求助
大家好,我正在做Excel VBA和Jira的集成开发,为了安全起见不想把个人访问令牌(PAT)硬编码在Excel文件里,所以选择用Windows凭据管理器来存储和读取这个令牌。目前写入凭据的CredWriteW代码已经能正常工作,但读取部分的CredReadW实现始终无法正确获取到存储的令牌,想请各位帮忙排查下问题所在。
环境信息
- Windows 11 操作系统
- Microsoft Office 2019(64位版本)
可正常工作的凭据写入代码
我用以下代码成功将凭据写入Windows凭据管理器:
Private Declare PtrSafe Function CredWrite Lib "advapi32.dll" Alias "CredWriteW" (ByRef credential As CREDENTIALW, ByVal Flags As Long) As Long Private Const CRED_TYPE_GENERIC = 1 Private Const TargetName = "JIRA_Excel_Integration" Private Type CREDENTIALW Flags As Long Type As Long TargetName As LongPtr Comment As LongPtr LastWritten As Currency CredentialBlobSize As Long CredentialBlob As LongPtr Persist As Long AttributeCount As Long Attributes As LongPtr TargetAlias As LongPtr UserName As LongPtr End Type Sub SaveCredentials(ByVal email As String, ByVal token As String) Dim cred As CREDENTIALW If email = "" Or token = "" Then Exit Sub With cred .Type = CRED_TYPE_GENERIC .TargetName = StrPtr(TargetName) .CredentialBlobSize = LenB(token) .CredentialBlob = StrPtr(token) .UserName = StrPtr(email) .Persist = 2 ' CRED_PERSIST_LOCAL_MACHINE .Flags = 0 End With If CredWrite(cred, 0) Then MsgBox "Credential saved.", vbInformation Else MsgBox "Error saving credential.", vbCritical End If End Sub
存在问题的凭据读取代码
以下是我目前的读取凭据代码,CredReadW会返回True,但最终无法获取到令牌内容:
Private Declare PtrSafe Function CredRead Lib "advapi32.dll" Alias "CredReadW" (ByVal TargetName As String, ByVal CredType As Long, ByVal Flags As Long, ByVal CREDENTIAL As LongPtr) As Boolean Private Declare PtrSafe Function lstrlen Lib "kernel32.dll" Alias "lstrlenW" (ByVal lpString As LongPtr) As Long Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr) Private Const CRED_TYPE_GENERIC = 1 Private Const TargetName = "JIRA_Excel_Integration" Private Type CREDENTIALW Flags As Long Type As Long TargetName As LongPtr Comment As LongPtr LastWritten As Currency CredentialBlobSize As Long CredentialBlob As LongPtr Persist As Long AttributeCount As Long Attributes As LongPtr TargetAlias As LongPtr UserName As LongPtr End Type Function GetCredentials() As String Dim credPtr As LongPtr Dim cred As CREDENTIALW Dim TokenBytes() As Byte Dim token As String credPtr = VarPtr(cred) If CredRead(TargetName, CRED_TYPE_GENERIC, 0, credPtr) = 0 Then CopyMemory cred, ByVal credPtr, LenB(cred) If cred.CredentialBlobSize > 0 Then ReDim TokenBytes(cred.CredentialBlobSize - 1) CopyMemory TokenBytes(0), ByVal cred.CredentialBlob, cred.CredentialBlobSize token = StrConv(TokenBytes, vbUnicode) End If GetCredentials = token Else GetCredentials = "" End If End Function
具体问题现象
- 调用
CredRead时返回值为True,直接进入了Else分支返回空字符串,完全没执行读取CredentialBlob的核心逻辑 - 我尝试调整过
CopyMemory的参数传递方式,但始终没解决问题 - 已经确认
TargetName和写入时的完全一致,凭据确实已经存储在Windows凭据管理器中
想请教各位,我的读取代码逻辑哪里出错了?应该如何修改才能正确读取到存储的PAT令牌?




