Application.FileDialog(msoFileDialo gFilePicker) выдаёт ошибку

[EducatedFool]

Уже не первый год использую следущий код для отображения диалогового окна выбора папки:

Sub ПримерИспользования()
    MsgBox "Выбрана папка: " & GetFolderPath
End Sub

Function GetFolderPath(Optional ByVal Title As String = "Выберите папку", _
                       Optional ByVal InitialPath As String = "c:\") As String
    With Application.FileDialog(msoFileDialogFilePicker) ' msoFileDialogFilePicker=4
        .ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
        If .Show = -1 Then GetFolderPath = .SelectedItems(1)
    End With
End Function

До недавнего времени проблем с этим кодом не было.

На днях выяснилось, что у одного пользователя этот код вылетает с ошибкой 438 "Object doesn't support this property or method"
(вылетает на строке с Application.FileDialog)

Причем конфигурация Windows и Office у этого пользователя такая же, как и у меня (WindowsXP, Office2003)
Пробовал менять название константы msoFileDialogFilePicker на её значение 4 - не помогает.

В чём может быть проблема?

Пожалуйста, проверьте, у всех ли работает этот макрос - не вылетает ли сообщение об ошибке:
(пример в файле - для запуска жмём зеленую кнопку)

[SAS888]

Проверил в Excel 2003 и в Excel 2007 (WinXP). Ошибки нет. Постоянно использую подобные конструкции. Жалоб не было. Думаю, что причину ошибки нужно искать не в коде, а на "проблемном" компьютере.

[Maxx]

Win XP, Excel 2007. Работает без ошибок!

[doober]

WinXP Проверил в Excel 2003 и в Excel 2007
Работает нормально

[The_Prist]

Судя по ошибке - все же не совсем 2003. Метод FileDialog появился лишь в 2003 версии Excel и возможно не в самой первой(источник умалчивает - возможно какие-то паки и прочая чушь, хотя лично я верю в это с трудом).

Посмотрите, что выдаст такая строка:

Debug.Print Application.Version

[Eresiarh]

Может быть это разъяснит сей момент:

A run-time error will occur if the Filters property is used in conjunction with the Clear, Add, or Delete methods when applied to a Save As FileDiaog object. For example, Application.FileDialog(msoFileDialo gSaveAs).Filters.Clear will result in a run-time error.

http://msdn.microsoft.com/en-us/libr...ffice.11).aspx

А так как такого здесь нет, то остается проверить все ли подключены бибилиотеки. Другого решения Интеренет не знает.

[Eresiarh]

Кстати, интереса ради проверил на 15 машинах. Практически на каждой сборки Windows XP и Excel2003 различны. И на каждой запустилось без проблем. Что удивительно. Так как VBA использовался только на трех. Обычно приходиться подправлять библиотеки.

[masterenergy]

Работает Windows Xp, Office 2007.

[EducatedFool]

Спасибо большое всем за проверку кода.
Теперь понятно, что проблема не в нём.

Метод FileDialog появился лишь в 2003 версии Excel

А вот этого не знал...
Заказчик утверждает, что использует Excel 2003, хотя, на самом деле, может оказаться, что 2002.
Надо будет проверить.

А пока пришлось использовать такую конструкцию:

Private Const dhcMaxPath = 260
Private Const dhcNoError = 0&
Private Const dhcErrorExtendedError = 1208&
Private Const MAX_PATH = 260
Private Declare Function SHGetSpecialFolderLocation Lib "Shell32.DLL" (ByVal hwndOwner As Long, ByVal Folder As Long, ByRef idl As Long) As Long
Private Declare Function SHBrowseForFolder Lib "Shell32.DLL" (ByRef bi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32.DLL" (ByVal idl As Long, ByVal path As String) As Integer
Private Type BrowseInfo
    hwndOwner As Long    ' Owner
    pidlRoot As Long    ' Can be null
    strDisplayName As String    ' Rcvs display name of folder (32 bytes)
    strTitle As String    ' title/instructions for user
    ulFlags As Long    ' 0 or BIF constants
    ' You won't use any of the following fields, from VBA.
    lpfn As Long    ' Address for callback: use NULL
    lParam As Long    ' Passes to callback
    iImage As Long    ' index to the system image list
End Type



Public Function GetDirName(HeaderMessage As String) As String
    Dim a As Long, strFolder As String

    a = dhBrowseForFolder(a, a, strFolder, 0, HeaderMessage)

    If a = dhcErrorExtendedError Then
        GetDirName = ""
    Else
        GetDirName = strFolder
    End If

End Function

Private Function dhBrowseForFolder( _
        ByVal lngCSIDL As Long, ByVal lngBifFlags As Long, strFolder As String, _
        Optional ByVal hWnd As Long = 0, _
        Optional strTitle As String = "Select Directory") As Long
    Dim usrBrws As BrowseInfo
    Dim lngReturn As Long
    Dim lngIDL As Long
    Dim Break_Mode As Long

    If SHGetSpecialFolderLocation(hWnd, lngCSIDL, lngIDL) = 0 Then
        With usrBrws
            .hwndOwner = hWnd
            .pidlRoot = lngIDL
            .strDisplayName = String$(dhcMaxPath, vbNullChar)
            .strTitle = strTitle
            .ulFlags = lngBifFlags
        End With
        Break_Mode = Application.EnableCancelKey
        Application.EnableCancelKey = xlDisabled
        lngIDL = SHBrowseForFolder(usrBrws)
        Application.EnableCancelKey = Break_Mode
        If lngIDL Then
            strFolder = String$(dhcMaxPath, vbNullChar)
            If SHGetPathFromIDList(lngIDL, strFolder) Then
                strFolder = dhTrimNull(strFolder)
                lngReturn = dhcNoError
            Else
                strFolder = dhTrimNull(usrBrws.strDisplayName)
                lngReturn = dhcNoError
            End If
        Else
            lngReturn = dhcErrorExtendedError
        End If
    Else
        lngReturn = dhcErrorExtendedError
    End If
    dhBrowseForFolder = lngReturn
End Function

Private Function dhTrimNull(ByVal strValue As String) As String
    Dim intPos As Integer
    intPos = InStr(strValue, vbNullChar)
    Select Case intPos
        Case 0
            dhTrimNull = strValue
        Case 1
            dhTrimNull = ""
        Case Is > 1
            dhTrimNull = Left$(strValue, intPos - 1)
    End Select
End Function

[segail]

Excel 2007 (WinXP) Отлично функционирует