在 VBA 中查找适用于 MS Access 和 MS Excel 的应用程序目录路径

Posted 2023-05-07

【中文标题】在 VBA 中查找适用于 MS Access 和 MS Excel 的应用程序目录路径

【英文标题】：Find application directory path in VBA workable for both MS Access and MS Excel

【发布时间】：2021-10-22 05:04:30

【问题描述】：

我有一个 VBA 代码，可以从 MS Access 或 Excel 应用程序运行。 在部分代码（如下所示）中，我必须默认找到应用程序文件目录，以保存 CSV 文件。 代码在 Excel 中运行没有任何错误，但在 MS Access 中，编译器抱怨 并停在那里。 代码有什么问题？我还有其他方法可以找到适用于 MS Access 和 Excel 的文件路径吗？？

If CSVpath = vbNullString Then
    Select Case Application.Name  '' system in which the code is running from
        Case Is = "Microsoft Excel"  '' it raises an error in MS Access
            CSVpath = Application.ThisWorkbook.Path + "\DataSet_" + CStr(Format(Now(), "YYYY-MM-DD.HH.MM.SS")) + ".csv"
        Case Is = "Microsoft Access"
            CSVpath = Application.CurrentProject.Path + "\DataSet_" + CStr(Format(Now(), "YYYY-MM-DD.HH.MM.SS")) + ".csv"
        Case Else
            CSVpath = ""
    End Select
End If

【问题讨论】：

代码对我来说很好用。你可以试试Case "Microsoft Excel" ....

在访问中Application 对象没有ThisWorkbook 属性，因此您的代码无法在那里编译。你可以试试CallByName(Application, "ThisWorkbook").Path

@TimWilliams - 我测试并不得不使用CallByName(Application, "ThisWorkbook", VbGet).Path

@braX - 谢谢，我想我可能错过了什么......

【参考方案1】：

我会尝试这样，使用字符串变量强制转换Application 的主文档对象。

这样，如果您以后对文件名改变主意，您只需在一个地方进行更改。

另外，我添加了一个检查文件是否尚未保存的可能性（那时它不会有路径）

Sub Test()
    Dim DocObjName As String
    Dim DocPath As String
    Dim CSVFullFilename As String

    Select Case Application.Name
        Case "Microsoft Excel"
            DocObjName = "ThisWorkbook"
        Case "Microsoft Access"
            DocObjName = "CurrentProject"
        Case "Microsoft Word"
            DocObjName = "ActiveDocument"
        Case "Microsoft PowerPoint"
            DocObjName = "ActivePresentation"
        Case Else
            ' if it stops here, you know you have made a programming error to fix
            ' add another case based on the application you are using?
            ' do not just set it to an empty string and let it continue
            Stop
            Exit Sub
    End Select
    
    DocPath = CallByName(Application, DocObjName, VbGet).Path
    If Len(DocPath) = 0 Then
        MsgBox "Error: File has not yet been saved, so there is no path to use", vbCritical
        Exit Sub
    Else
        CSVFullFilename = DocPath & "\DataSet_" & Format(Now(), "YYYY-MM-DD.HH.MM.SS") & ".csv"
    End If
    
    Debug.Print CSVFullFilename
End Sub

为了更好地命名变量，我会使用 CSVFullFilename 之类的东西而不是 CSVpath，因为它不仅仅是一条路径 - 但这只是个人喜好。

【参考方案2】：

对于 MS-Access 尝试：

Application.StartupPath & "\your resource  database name"

Application.StartupPath 将为您提供可执行 (.exe) 文件的位置。 & "\your resource database name" 是你的文件名。确保将其放在与 .exe 相同的文件夹中