CurDir() возвращает несколько путей в случайном порядке

Question

Я разработал VBAProject в пределах MicroSoft Outlook 2010, содержащий пару UserForms и модуль, который содержит код для запуска UserForms.

Мне нужно получить текущую директорию выполнения для этого макроса/VBAProject для определенных целей, и поэтому для этого я использую функцию CurDir. Вопрос заключается в том, что CurDir возвращает одно из следующих значений: спорадически

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

Там нет конкретных моделей, чтобы определить, когда-то, что возвращается. Каждый раз, когда выполняется строка MsgBox CurDir, возвращается один из указанных выше путей, а в следующий раз он другой и т. Д. Это происходит без каких-либо изменений кода или способа запуска Outlook и Macro.

Мне нужно знать, как я могу получить правильный и согласованный путь, в котором программа выполняется, подобно Shell.CurrentDirectory в VBScript.

Answer 1

CurDir() Функция возвращает текущий путь.

И

Он начинается с пути пользователя по умолчанию, как правило, мои-документы. Если пользователь просматривает другой путь через пользовательский интерфейс (например, Open/Save) 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