B.WH

Private Sub btnGetPicture_Click()

Static keepFolder As String
Dim wkPath As String

' ファイル選択はFileDialog
With FileDialog(1)
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "画像ファイル", "*.jpg;*.jpeg;*.gif;*.png;*.bmp;*.ico"
    .Filters.Add "すべて", "*.*"
    .Title = "画像を選択"
    If keepFolder = "" Then keepFolder = CurrentProject.Path & "\"
    .InitialFileName = keepFolder
    If .Show = True Then wkPath = .SelectedItems(1)
End With

' 選択したファイルに不都合はないか？
If wkPath = "" Then Exit Sub
Select Case True
    Case wkPath Like "*.jpg"
    Case wkPath Like "*.jpeg"
    Case wkPath Like "*.gif"
    Case wkPath Like "*.png"
    Case wkPath Like "*.bmp"
    Case wkPath Like "*.ico"
    Case Else: Beep: Exit Sub
End Select
If Dir(wkPath) = "" Then Beep: Exit Sub

' 一旦レコードを保存
On Error Resume Next
DoCmd.RunCommand acCmdSaveRecord
On Error GoTo 0

' 添付ファイル保存処理
Me.Recordset.Edit
    With Me.Recordset![添付ファイル型フィールド名].Value
        '添付ファイルの数でアクションを変更
        If .RecordCount > 1 Then
            MsgBox "添付ファイルが複数あります", vbCritical, "添付ファイルエラー"
        Else
            If .RecordCount = 1 Then
                .Edit
            Else
                .AddNew
            End If
            !FileData.LoadFromFile wkPath
            .Update
        End If
        .Close
    End With
Me.Recordset.Update

Me![添付ファイルコントロール名].Requery

keepFolder = Left(wkPath, InStrRev(wkPath, "\")) '末尾\付き

End Sub