Question

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

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

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

没有特定的模式可以确定何时返回。每次执行行MsgBox CurDir时，都会返回上述路径之一，下一次路径不同，依此类推。发生这种情况时，代码或Outlook和宏的启动方式绝对没有变化。

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

Answer 1

CurDir()函数返回当前路径。

和

它以默认用户路径开头，通常是my-docs。如果用户通过UI浏览到不同的路径（例如打开/保存）CurDir将返回该路径。理论上，不同Office应用程序的多个实例可以同时返回不同的CurDir 可以使用CurDir
更改主机应用的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（）随机返回几个路径

1 个答案: