Кнопка для добавления фото в форме

[Adidas7]

Здравствуйте, добрые люди! Мне нужно, чтобы фото брались из любой папки, а не из определенной. У меня есть коды. Помогите мне их изменить. Простите, я плохо разбираюсь в VBA.

Private Sub Form_Current()
On Error Resume Next
a = DLookup("[PathPictureBook]", "[Личные данные]", _
            "[Код] = " & Me.Код)
If Len(Nz(" & a & ", "")) = 0 Then
Me![MyPic].Picture = ""
Else
strPath = CurrentProject.Path 'Определяем текущий путь
Me![MyPic].Picture = strPath & "\" & "HumanFoto" & "\" & a 'Отображаем картинку
End If
End Sub

Private Sub btnADD_Click()
On Error Resume Next
    Dim fileName As String
    Dim result As Integer
    Dim i As Integer

    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Выберите изображение" 'Заголовок
        .Filters.Clear 'Очищаем фильтр
        .Filters.Add "Все файлы", "*.*"
        .Filters.Add "bmp", "*.bmp"
        .Filters.Add "gif", "*.gif"
        .Filters.Add "jpeg", "*.jpeg"
        .Filters.Add "jpg", "*.jpg"
       .FilterIndex = 1
        .AllowMultiSelect = False 'Отключаем множественный выбор
       .InitialFileName = " " 'Путь по умолчанию(текущая папка)
        result = .Show
        If (result <> 0) Then
            fileName = Trim(.SelectedItems.Item(1))
            i = InStrRev(fileName, "\") 'Высчитываем количество знаков до "\" файла
            Me![PathPictureBook].SetFocus 'Устанавливаем фокус
            Me![PathPictureBook].Text = Right(fileName, Len(fileName) - i) 'Название файла

            strPath = CurrentProject.Path 'Определяем текущий путь
            Me![MyPic].Picture = strPath & "\" & "HumanFoto" & "\" & Right(fileName, Len(fileName) - i) 'Отображаем картинку
        End If
    End With
End Sub

[Adidas7]

Здесь берутся фото из папки HumanFoto. А мне нужно, чтобы из любой папки. Поможете?

[doober]

Можно так

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

Private Sub Form_Current()
On Error Resume Next
a = DLookup("[PathPictureBook]", "[Личные данные]", _
            "[Код] = " & Me.Код)
If Len(Nz(" & a & ", "")) = 0 Then
Me![MyPic].Picture = ""
Else
strPath = GetFolderPath
Me![MyPic].Picture = strPath & "\" & a  'Отображаем картинку
End If
................

[Adidas7]

Сообщение от doober

Можно так

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

Private Sub Form_Current()
On Error Resume Next
a = DLookup("[PathPictureBook]", "[Личные данные]", _
            "[Код] = " & Me.Код)
If Len(Nz(" & a & ", "")) = 0 Then
Me![MyPic].Picture = ""
Else
strPath = GetFolderPath
Me![MyPic].Picture = strPath & "\" & a  'Отображаем картинку
End If
................

Здесь при открытии формы открывается диалоговое окно... А мне нужно чтобы только при нажатии кнопки оно открывалось.

[Myhaylo]

Перенесите текст, находящийся между строками

Private Sub Form_Current()

и

.........

в подпрограмму обработки события "Нажатие кноки" (Click).