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

Leo*_*Sam 2 excel ms-access vba

我有一个 VBA 代码,可以从 MS Access 或 Excel 应用程序运行。
在代码的一部分(如下所示)中,我必须找到默认的应用程序文件目录,以保存 CSV 文件。
该代码在 Excel 中运行没有任何错误,但在 MS Access 中,编译器会抱怨 <Application.ThisWorkbook.Path> 并在那里停止。
代码有什么问题吗?我还有其他方法可以找到适用于 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
Run Code Online (Sandbox Code Playgroud)

bra*_*raX 5

我会这样尝试,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
Run Code Online (Sandbox Code Playgroud)

为了良好的变量命名,我会使用类似的东西CSVFullFilename来代替CSVpath,因为它不仅仅是一条路径 - 但这只是个人喜好。