Excel VBA中除工作表外，存储文件夹及ACCDB路径的其他方法？

嘿，我太懂你不想依赖工作表存路径的痛点了——毕竟不熟练的用户误改单元格太容易，变量又没法持久化。下面给你几个实用的方案，全是脱离工作表、能稳定保存路径的：

1. VBA工程自定义属性 #

这个路径是存在VBA工程本身里的，用户除非打开VBA编辑器，否则根本碰不到，安全性拉满。你可以把它当成工程的「隐藏配置」：

' 写入路径到工程属性
Sub SaveAccdbPathToProject()
    Dim proj As VBProject
    Dim prop As VBIDE.Property
    
    Set proj = ThisWorkbook.VBProject
    ' 先检查属性是否存在，不存在就创建
    On Error Resume Next
    Set prop = proj.Properties("AccdbPath")
    On Error GoTo 0
    
    If prop Is Nothing Then
        proj.Properties.Add "AccdbPath", "C:\YourPath\YourDatabase.accdb"
    Else
        prop.Value = "C:\YourPath\YourDatabase.accdb"
    End If
End Sub

' 读取路径
Sub GetAccdbPathFromProject()
    Dim proj As VBProject
    Dim accdbPath As String
    
    Set proj = ThisWorkbook.VBProject
    On Error Resume Next
    accdbPath = proj.Properties("AccdbPath")
    On Error GoTo 0
    
    If accdbPath <> "" Then
        MsgBox "ACCDB路径：" & accdbPath
        ' 这里可以写你的ADODB操作代码
    Else
        MsgBox "未找到存储的路径，请先设置"
    End If
End Sub

注意：要确保VBA编辑器的信任中心允许访问VBA对象模型，不然会报错。另外可以给VBA工程设置密码，防止用户随意修改。

2. 系统注册表存储 #

把路径存在Windows注册表的专用区域，关闭Excel后数据也不会丢失，而且用户一般不会去动这个位置：

' 写入路径到注册表
Sub SaveAccdbPathToRegistry()
    ' 这里的AppName可以改成你的项目名，比如"MyAccdbTool"
    SaveSetting AppName:="MyAccdbTool", Section:="Database", Key:="AccdbPath", _
                Setting:="C:\YourPath\YourDatabase.accdb"
End Sub

' 读取路径
Sub GetAccdbPathFromRegistry()
    Dim accdbPath As String
    accdbPath = GetSetting(AppName:="MyAccdbTool", Section:="Database", Key:="AccdbPath", _
                          Default:="")
    
    If accdbPath <> "" Then
        MsgBox "ACCDB路径：" & accdbPath
    Else
        MsgBox "未找到存储的路径，请先设置"
    End If
End Sub

这个方法的好处是可以跨Excel文件共享配置（如果你的工具是多个工作簿的话），数据存在HKEY_CURRENT_USER\Software\VB and VBA Program Settings下面，非常隐蔽。

3. Excel工作簿自定义文档属性 #

这个是把路径存在工作簿的内置属性里，不是工作表单元格，用户在Excel界面里要找到得进「文件>信息>属性>高级属性」，很少会误碰：

' 写入路径到自定义文档属性
Sub SaveAccdbPathToDocProps()
    Dim prop As DocumentProperty
    
    On Error Resume Next
    Set prop = ThisWorkbook.CustomDocumentProperties("AccdbPath")
    On Error GoTo 0
    
    If prop Is Nothing Then
        ThisWorkbook.CustomDocumentProperties.Add _
            Name:="AccdbPath", _
            LinkToContent:=False, _
            Type:=msoPropertyTypeString, _
            Value:="C:\YourPath\YourDatabase.accdb"
    Else
        prop.Value = "C:\YourPath\YourDatabase.accdb"
    End If
End Sub

' 读取路径
Sub GetAccdbPathFromDocProps()
    Dim accdbPath As String
    
    On Error Resume Next
    accdbPath = ThisWorkbook.CustomDocumentProperties("AccdbPath").Value
    On Error GoTo 0
    
    If accdbPath <> "" Then
        MsgBox "ACCDB路径：" & accdbPath
    Else
        MsgBox "未找到存储的路径，请先设置"
    End If
End Sub

这个方案和工作簿绑定，换电脑的时候只要把Excel文件带走，路径配置也跟着走，非常方便。

4. 外部配置文件（INI/XML） #

如果偶尔需要手动修改路径（比如换了数据库位置），可以用INI或XML文件存路径，把文件放在Excel所在目录的隐蔽子文件夹里，比如.\Config\db.ini：

INI文件示例（需要调用Windows API） #

' 声明API
Private Declare PtrSafe Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" _
    (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Private Declare PtrSafe Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _
    (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, _
    ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

' 写入路径到INI
Sub SaveAccdbPathToINI()
    Dim iniPath As String
    iniPath = ThisWorkbook.Path & "\Config\db.ini"
    ' 确保Config文件夹存在
    If Dir(ThisWorkbook.Path & "\Config", vbDirectory) = "" Then
        MkDir ThisWorkbook.Path & "\Config"
    End If
    WritePrivateProfileString "Database", "AccdbPath", "C:\YourPath\YourDatabase.accdb", iniPath
End Sub

' 读取路径
Sub GetAccdbPathFromINI()
    Dim iniPath As String
    Dim accdbPath As String * 256
    Dim retLen As Long
    
    iniPath = ThisWorkbook.Path & "\Config\db.ini"
    retLen = GetPrivateProfileString("Database", "AccdbPath", "", accdbPath, 256, iniPath)
    accdbPath = Left(accdbPath, retLen)
    
    If accdbPath <> "" Then
        MsgBox "ACCDB路径：" & accdbPath
    Else
        MsgBox "未找到存储的路径，请先设置"
    End If
End Sub

选哪个方案？ #

• 如果想完全隐蔽，不想用户碰任何配置：优先选VBA工程自定义属性或注册表
• 如果想配置和工作簿绑定，换电脑方便：选自定义文档属性
• 如果需要偶尔手动修改路径：选外部配置文件

内容的提问来源于stack exchange，提问作者Raphael Yaghdjian