CurDir() returns 随机数条路径

Question

我在 MicroSoft Outlook 2010 中开发了一个 VBAProject，其中包含几个用户窗体和一个包含启动用户窗体的代码的模块。

出于特定目的，我需要能够检索此 Macro/VBAProject 的当前执行目录，因此我为此使用了 CurDir 函数。问题是 CurDir returns 偶尔会出现以下值之一：

%USERPROFILE\Desktop\
%USERPROFILE\Documents\
C:\Program Files\Microsoft Office\Office14\

没有特定的模式来确定何时返回什么。每次执行 MsgBox CurDir 行时，返回上述路径之一，下一次返回另一个路径，依此类推。这发生在代码或 Outlook 和宏的启动方式完全没有变化的情况下。

我需要知道如何获得正确且一致的程序执行路径，类似于 VBScript 中的 Shell.CurrentDirectory。

Answer 1

CurDir() function returns the current path.

和

It starts with the default user path, typically my-docs. If the user browses to a different path through the UI (e.g. Open/Save) CurDir will return that. In theory multiple instances of different Office apps could return a different CurDir at the same time.
CurDir for the host app can be changed with ChDir

您可以使用此代码和 GetOutlookPath() 函数：

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private Const REG_SZ As Long = 1
Private Const KEY_ALL_ACCESS = &H3F
Private Const HKEY_LOCAL_MACHINE = &H80000002

Public Function GetOutlookPath() As String
    GetOutlookPath = GetOfficeAppPath("Outlook.Application")
End Function

Private Function GetOfficeAppPath(ByVal ProgID As String) As String
Dim lKey As Long
Dim lRet As Long
Dim sClassID As String
Dim sAns As String
Dim lngBuffer As Long
Dim lPos As Long

    'GetClassID
    lRet = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Classes\" & ProgID & "\CLSID", 0&, KEY_ALL_ACCESS, lKey)
    If lRet = 0 Then
        lRet = RegQueryValueEx(lKey, "", 0&, REG_SZ, "", lngBuffer)
        sClassID = Space(lngBuffer)
        lRet = RegQueryValueEx(lKey, "", 0&, REG_SZ, sClassID, lngBuffer)
        'drop null-terminator
        sClassID = Left(sClassID, lngBuffer - 1)
        RegCloseKey lKey
    End If

    'Get AppPath
    lRet = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Classes\CLSID\" & sClassID & "\LocalServer32", 0&, KEY_ALL_ACCESS, lKey)

    If lRet = 0 Then
        lRet = RegQueryValueEx(lKey, "", 0&, REG_SZ, "", lngBuffer)
        sAns = Space(lngBuffer)
        lRet = RegQueryValueEx(lKey, "", 0&, REG_SZ, sAns, lngBuffer)
        sAns = Left(sAns, lngBuffer - 1)
        RegCloseKey lKey
    End If

    'Sometimes the registry will return a switch beginning with "/" e.g., "/automation"
    lPos = InStr(sAns, "/")
    If lPos > 0 Then
        sAns = Trim(Left(sAns, lPos - 1))
    End If

    GetOfficeAppPath = sAns
End Function

CurDir() returns 随机数条路径

CurDir() returns several paths at random

outlook

vba