标签： VBA

封装ADODB数据库查询的Excel VBA类模块

关于Excel操纵数据库可以参考前面文章：如何利用Excel的数据源功能实现多表合并和 SQL 查询以及如何动态修改Excel数据源的数据来源和数据源的查询语句。这里再放出一个我平常使用的封装ADODB数据库查询的Excel VBA类模块。

在使用之前，先需要声明一个类实例：

Dim db as New Database
继续阅读“封装ADODB数据库查询的Excel VBA类模块”

动态修改Excel数据表的数据来源

Excel 有一个很有用的功能是直接导入外部数据库或者使用外部数据源建立数据透视表和数据透视图。但比较可惜的是，这个数据源的查询语句是静态的，它无法根据日期自动修改（比如在应用中，我们希望每天获取的外部数据都是当天最新的数据），下面两个函数是修改外部数据源的 VBA 代码，调用它们就可以建立动态的数据源。

' 更改数据表的来源
' wb：工作表对象
' connectionName：数据来源连接名称
' strSQL：新查询语句（修改SQL的查询代码）
' strSQLConnection：新连接语句（修改来源数据库，在对DBF数据库操作时非常有用）
' author: zhang@zhiqiang.org, 2010
Public Sub ChangeODBCConnection(wb As Excel.Workbook, connectionName As String, _
        Optional strSQL As String = "", Optional strSQLConnection As String = "")

    With wb.Connections(connectionName).ODBCConnection
        If Len(strSQLConnection) Then .CommandText = SplitString(strSQLConnection)
        If Len(strSQL) Then .Connection = SplitString(strSQL)
    End With
    wb.Connections(connectionName).Refresh
End Sub

' 更改数据表的来源
' pc：数据透视表的PivotCache对象 （例如：ActiveSheet.PivotTables(1).PivotCache）
' connectionName：数据来源连接名称
' strSQL：新查询语句（修改SQL的查询代码）
' strSQLConnection：新连接语句（修改来源数据库，在对DBF数据库操作时非常有用）
' author: zhang@zhiqiang.org, 2010
Public Sub ChangePivotConnection(pc As Excel.PivotCache, Optional strSQLConnect, _
        Optional strSQL As String = "")
    Dim blnODBCConnect As Boolean

    With pc
        If .QueryType = xlODBCQuery Then
            blnODBCConnect = True
            If Len(strSQLConnect) = 0 Then strSQLConnect = .Connection
            strSQLConnect = Replace(strSQLConnect, "ODBC;DSN", "OLEDB;DSN", 1, 1, vbTextCompare)
        End If

        If StrComp(.Connection, strSQLConnect, vbTextCompare) <> 0 And Len(strSQLConnect) Then
            .Connection = strSQLConnect
        End If

        If StrComp(.CommandText, strSQL, vbTextCompare) <> 0 And Len(strSQL) Then
            .CommandText = (strSQL)
        End If

        If blnODBCConnect = True Then
            .Connection = Replace(.Connection, "OLEDB;DSN", "ODBC;DSN", 1, 1, vbTextCompare)
        End If

        .Refresh
    End With
End Sub

' 将字符串分割成短字符串的数组
Private Function SplitString(ByVal s As String) As Variant
    Dim ss() As Variant
    Dim i As Long

    ReDim ss(0 To Len(s) \ 200) ' note: it is not 256
    For i = 0 To UBound(ss)
        ss(i) = Array(Mid(s, i * 200 + 1, 200))
    Next i

    SplitString = ss
End Function

原文：https://zhiqiang.org/coding/change-pivotcache-source.html

VBA应用实例

1、用密码保护VBA代码不被非法执行

Sub Protect()
    Dim PW As Variant
    '一、密码校验部分
    PW = Application.InputBox("请输入密码", "Password Protected")
    
    Select Case PW
        '情况①：当用户取消(Cancel)输入
        Case Is = False
            'Do Nothing
            Exit Sub
        
        '情况②：当用户输入密码正确
        Case Is = "abc123"
            MsgBox "密码验证成功，将继续运行程序！"
            
        '情况③：当用户输入密码错误
        Case Else
            MsgBox "密码输入错误，不能执行本程序！"
            Exit Sub
    End Select
    
    '二、程序主体部分
    Rem VBA Codes...
End Sub
继续阅读“VBA应用实例”