VBA调用sql语句时不要显示密码

在VBA中调用SQL连接数据库时隐藏密码，核心是避免直接在代码中明文写密码，这既是安全规范，也能防止密码泄露。以下是3种实用且安全的实现方法，从简单到进阶适配不同场景：

一、基础版：用InputBox弹窗输入密码（适合临时使用）

通过弹窗让用户手动输入密码，代码中不存储任何密码信息，简单易实现：

vba 复制代码

Sub SQL_Connect_InputPwd()
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim sqlStr As String
    Dim serverIP As String, dbName As String, userName As String, pwd As String
    
    ' 基础信息（可固定，密码手动输入）
    serverIP = "192.168.1.100"  ' 服务器IP
    dbName = "销售数据库"       ' 数据库名
    userName = "admin"          ' 用户名
    
    ' 弹窗输入密码（密码框隐藏输入内容）
    pwd = InputBox("请输入数据库密码：", "密码验证", "", , , , , 2)
    If pwd = "" Then  ' 取消输入则退出
        MsgBox "密码不能为空！", vbExclamation
        Exit Sub
    End If
    
    ' 拼接连接字符串（密码来自输入，非明文）
    On Error Resume Next  ' 捕获连接错误
    conn.Open "Provider=SQLOLEDB;Data Source=" & serverIP & _
              ";Initial Catalog=" & dbName & _
              ";User ID=" & userName & ";Password=" & pwd & ";"
    
    If Err.Number <> 0 Then
        MsgBox "连接失败：" & Err.Description, vbCritical
        Exit Sub
    End If
    
    ' 执行SQL查询（示例）
    sqlStr = "SELECT * FROM 订单表 WHERE 日期 >= '2024-01-01'"
    rs.Open sqlStr, conn
    Sheet1.Range("A1").CopyFromRecordset rs
    
    ' 关闭资源
    rs.Close: conn.Close
    Set rs = Nothing: Set conn = Nothing
End Sub

核心亮点：密码仅在运行时由用户输入，代码中无明文，适合单人临时使用。

二、进阶版：将密码加密存储在Excel单元格（适合固定用户）

先把密码加密后存在Excel隐藏工作表，运行时解密读取，避免明文且无需每次输入：

步骤1：加密/解密函数（核心）

vba 复制代码

' 简单加密/解密函数（自定义密钥，可修改）
Function EncryptDecrypt(str As String, key As Integer) As String
    Dim i As Integer, charCode As Integer
    For i = 1 To Len(str)
        charCode = Asc(Mid(str, i, 1)) Xor key  ' 异或加密
        EncryptDecrypt = EncryptDecrypt & Chr(charCode)
    Next i
End Function

步骤2：存储加密密码（仅需执行一次）

vba 复制代码

Sub Save_Encrypted_Pwd()
    Dim pwd As String, encryptedPwd As String
    pwd = InputBox("请输入原始密码：")
    encryptedPwd = EncryptDecrypt(pwd, 123)  ' 密钥123（自定义）
    
    ' 隐藏工作表存储密码（先创建名为"Config"的隐藏表）
    If Not SheetExists("Config") Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Config"
        Sheets("Config").Visible = xlSheetVeryHidden  ' 深度隐藏（仅VBA可访问）
    End If
    Sheets("Config").Range("A1") = encryptedPwd
    MsgBox "密码已加密存储！", vbInformation
End Sub

' 辅助函数：判断工作表是否存在
Function SheetExists(sheetName As String) As Boolean
    On Error Resume Next
    SheetExists = (Sheets(sheetName).Name <> "")
    On Error GoTo 0
End Function

步骤3：读取密码并连接数据库

vba 复制代码

Sub SQL_Connect_EncryptedPwd()
    Dim conn As New ADODB.Connection
    Dim encryptedPwd As String, pwd As String
    
    ' 读取加密密码并解密
    If Not SheetExists("Config") Then
        MsgBox "未配置密码！", vbExclamation
        Exit Sub
    End If
    encryptedPwd = Sheets("Config").Range("A1")
    pwd = EncryptDecrypt(encryptedPwd, 123)  ' 用相同密钥解密
    
    ' 连接数据库（密码已解密，无明文）
    conn.Open "Provider=SQLOLEDB;Data Source=192.168.1.100;" & _
              "Initial Catalog=销售数据库;User ID=admin;Password=" & pwd & ";"
    
    ' 后续SQL执行逻辑...
    conn.Close
    Set conn = Nothing
End Sub

核心亮点：密码加密存储在隐藏工作表，非明文且无需重复输入，适合固定电脑/固定用户使用。

三、专业版：使用Windows凭据管理器（适合企业/多场景）

将数据库密码存入Windows系统的「凭据管理器」，VBA通过API读取，最安全且符合企业规范：

vba 复制代码

' 声明API函数（需放在模块顶部）
#If VBA7 Then
    Private Declare PtrSafe Function CredRead Lib "advapi32.dll" Alias "CredReadW" (ByVal TargetName As LongPtr, ByVal Type As Long, ByVal Flags As Long, Credential As CREDENTIAL) As Boolean
    Private Declare PtrSafe Function CredFree Lib "advapi32.dll" (ByVal Credential As LongPtr) As Boolean
    Private Declare PtrSafe Function lstrlenW Lib "kernel32.dll" (ByVal lpString As LongPtr) As Long
#Else
    Private Declare Function CredRead Lib "advapi32.dll" Alias "CredReadW" (ByVal TargetName As Long, ByVal Type As Long, ByVal Flags As Long, Credential As CREDENTIAL) As Boolean
    Private Declare Function CredFree Lib "advapi32.dll" (ByVal Credential As Long) As Boolean
    Private Declare Function lstrlenW Lib "kernel32.dll" (ByVal lpString As Long) As Long
#End If

' 定义凭据结构体
Private Type CREDENTIAL
    Flags As Long
    Type As Long
    TargetName As LongPtr
    Comment As LongPtr
    LastWritten As FILETIME
    CredentialBlobSize As Long
    CredentialBlob As LongPtr
    Persist As Long
    AttributeCount As Long
    Attributes As LongPtr
    TargetAlias As LongPtr
    UserName As LongPtr
End Type

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

' 读取Windows凭据的函数
Function GetWindowsCredential(targetName As String) As String
    Dim cred As CREDENTIAL
    Dim success As Boolean
    Dim pwdStr As String
    
    success = CredRead(StrPtr(targetName), 1, 0, cred)
    If success Then
        ' 提取密码
        pwdStr = String$(cred.CredentialBlobSize, 0)
        CopyMemory ByVal StrPtr(pwdStr), ByVal cred.CredentialBlob, cred.CredentialBlobSize
        GetWindowsCredential = Left$(pwdStr, InStr(pwdStr, vbNullChar) - 1)
        CredFree cred.TargetName
    Else
        GetWindowsCredential = ""
    End If
End Function

' 核心连接函数
Sub SQL_Connect_WindowsCred()
    Dim conn As New ADODB.Connection
    Dim pwd As String
    
    ' 从Windows凭据管理器读取密码（需先手动添加凭据，名称为"DB_Sales"）
    pwd = GetWindowsCredential("DB_Sales")
    If pwd = "" Then
        MsgBox "未找到数据库凭据，请先在凭据管理器添加！", vbExclamation
        Exit Sub
    End If
    
    ' 连接数据库（密码来自系统凭据，代码无痕迹）
    conn.Open "Provider=SQLOLEDB;Data Source=192.168.1.100;" & _
              "Initial Catalog=销售数据库;User ID=admin;Password=" & pwd & ";"
    
    ' 后续SQL执行逻辑...
    conn.Close
    Set conn = Nothing
End Sub

使用前准备：

打开Windows「凭据管理器」→ 「Windows凭据」→ 「添加普通凭据」；
输入：Internet地址/名称=DB_Sales，用户名=admin，密码=你的数据库密码；
保存后，VBA即可通过GetWindowsCredential("DB_Sales")读取密码。
核心亮点：密码由系统管理，代码中无任何密码相关信息，符合企业安全规范，适合多用户/多电脑场景。

总结

临时使用：选「InputBox弹窗输入」，简单快捷，无密码存储风险；
固定用户/电脑：选「加密存储在隐藏单元格」，兼顾便捷与安全；
企业级应用：选「Windows凭据管理器」，最安全且符合规范，无密码泄露风险。

所有方法的核心都是避免密码明文出现在代码中，同时补充了错误处理，确保连接失败时能清晰提示问题，而非直接暴露密码相关信息。