Newsgroup: it.comp.appl.access
Titolo: Caricare un immagine tramite "Sfoglia..."

In un database inserisco i percorsi delle immagini (sono relativi alla 
posizione del file).
Al momento nella maschera faccio scrivere il nome del file: e' possibile 
fare in modo di avere una finestra tipo "Sfoglia" in cui fa magari anche 
vedere le immagini? Quella classica finestra di windows, senza niente di 
particolare. 

 ha scritto nel
messaggio news:mVdCd.622598$35.25...@news4.tin.it...

La routine che vedi subito sotto io la metto nelle Form
in quanto può essere gestita per le esigenze diverse, quello
che vedi più sotto dopo la Nota va messo in un modulo a parte.
Su Click del CmdButton richiami la funzione e supponendo di avere
un controllo textbox nel quale salvare il percorso:
Private Sub NomecmdButton_Click()
    Me.NomeTextBox= retImageFileName()
End sub
La configurazione attuale abilita già la selezione delle immagini
con i vari formati grafici, ma tu potresti avere problemi con la
visualizzazione
in Access di tutti, per i quali occorre adottare sistemi differenti.
In ogni caso per modificare i Filtri devi agire sulla parte di Codice in cui
trovi
l'elenco dei File e le estensioni........!
Private Function retImageFileName() as string
    Dim NomeFile As Variant
    Dim lngFlags As Long
    Dim gfni As accOfficeGetFileNameInfo
    Dim result As String
    On Error GoTo HandleErrors
    ' Questo lo abiliti per la Multiselezione
    'lngFlags = lngFlags Or adhcGfniAllowMultiSelect
    'Questo è il Preview
    lngFlags = lngFlags Or bacGfniInitializeView
    With gfni
        .lngView = 1
        .lngFlags = lngFlags
        .strFilter = ""
        'If Len(.strFilter) > 0 Then
        '    .lngFilterIndex = CInt(Me.txtFilterIndex)
        'End If
        .strFile = ""
        .strDlgTitle = "Selezione Immagini"
        .strOpenTitle = ""
        .strInitialDir = "C:\"
        .hwndOwner = Application.hWndAccessApp
    End With
    If OfficeGetFileName(gfni, -1) = 0 Then
        result = Trim(gfni.strFile)
        retImageFileName= result
        Form_Current
    End If
ExitHere:
    Exit Sub
HandleErrors:
    MsgBox "Error: " & Err.Description & " (" & Err.Number & ")"
    Resume ExitHere
End Sub
'******************************************************
'    QUESTA PARTE VA MESSA IN UN MODULO
'******************************************************
Option Compare Database
Option Explicit
' From Access 2000 Developer's Handbook, Volume I
' by Getz, Litwin, and Gilbert. (Sybex)
' Copyright 1999. All rights reserved.
Private Declare Function accOfficeGetFileName _
 Lib "msaccess.exe" Alias "#56" _
 (gfni As accOfficeGetFileNameInfo, fOpen As Integer) As Long
' Common Dialogs
' OfficeGetFileName errors
Public Const bacAccErrGFNSuccess = 0
Public Const bacAccErrGFNCantOpenDialog = -301
Public Const bacAccErrGFNUserCancelledDialog = -302
' OfficeGetFileName flags
Public Const bacGfniConfirmReplace = &H1              ' Prompt if
overwriting a file?
Public Const bacGfniNoChangeDir = &H2                 ' Don't change to the
directory the user selected?
Public Const bacGfniAllowMultiSelect = &H8            ' Allow
multiple-selection?
Public Const bacGfniDirectoryOnly = &H20              ' Open as directory
picker?
Public Const bacGfniInitializeView = &H40             ' Initialize the view
to the lView member or use last selected view?
' Views in the Office Find File dialog
Public Const bacGfniViewDetails = 0                  ' Details
Public Const bacGfniViewPreview = 1                  ' Preview
Public Const bacGfniViewProperties = 2               ' Properties
Public Const bacGfniViewList = 3                     ' List (typical)
Public Type accOfficeGetFileNameInfo
    hwndOwner As Long
    strAppName As String * 255
    strDlgTitle As String * 255
    strOpenTitle As String * 255
    strFile As String * 4096
    strInitialDir As String * 255
    strFilter As String * 255
    lngFilterIndex As Long
    lngView As Long
    lngFlags As Long
End Type
Public Function OfficeGetFileName( _
 gfni As accOfficeGetFileNameInfo, _
 ByVal fOpen As Integer) As Long
    ' Use the Office file selector common dialog
    ' exposed by Access.
    ' From Access 2000 Developer's Handbook, Volume I
    ' by Getz, Litwin, and Gilbert. (Sybex)
    ' Copyright 1999. All rights reserved.
    Dim lngReturn As Long
    With gfni
        .strAppName = RTrim$(.strAppName) & vbNullChar
        .strDlgTitle = RTrim$(.strDlgTitle) & vbNullChar
        .strOpenTitle = RTrim$(.strOpenTitle) & vbNullChar
        .strFile = RTrim$(.strFile) & vbNullChar
        .strInitialDir = RTrim$(.strInitialDir) & vbNullChar
        If Len(TrimNull(RTrim$(.strFilter))) = 0 Then
            '
            '    PARTE DA MODIFICARE PER LA GESTIONE FILTRI
            .strFilter = "Tutti formati Immagini
(*.bmp;*.jpg;*.jpeg;*.gif;*.tiff;*.png;*.wmf;*.emf;*.cur;*.ico)" & _
                         "|Immagini BMP (*.bmp)" & _
                         "|Immagini JPG (*.jpg)" & _
                         "|Immagini JPEG (*.jpeg)" & _
                         "|Immagini PNG (*.png)" & _
                         "|Immagini GIF (*.gif)" & _
                         "|Immagini TIFF (*.tiff)" & _
                         "|Immagini WMF (*.wmf)" & _
                         "|Immagini EMF (*.emf)" & _
                         "|Immagini ICO (*.ico)" & _
                         "|Immagini CUR (*.cur)"
            .lngFilterIndex = 0
        End If
        .strFilter = RTrim$(.strFilter) & vbNullChar
        lngReturn = accOfficeGetFileName(gfni, fOpen)
        .strAppName = TrimNull(.strAppName)
        .strDlgTitle = TrimNull(.strDlgTitle)
        .strOpenTitle = TrimNull(.strOpenTitle)
        .strFile = TrimNull(.strFile)
        .strInitialDir = TrimNull(.strInitialDir)
        .strFilter = TrimNull(.strFilter)
    End With
    OfficeGetFileName = lngReturn
End Function
Public Function TrimNull(strVal As String) As String
    ' From Access 2000 Developer's Handbook, Volume I
    ' by Getz, Litwin, and Gilbert. (Sybex)
    ' Copyright 1999. All rights reserved.
    ' Trim the end of a string, stopping at the first
    ' null character.
    Dim intPos As Integer
    intPos = InStr(1, strVal, vbNullChar)
    Select Case intPos
        Case Is > 1
            TrimNull = Left$(strVal, intPos - 1)
        Case 0
            TrimNull = strVal
        Case 1
            TrimNull = vbNullString
    End Select
End Function
Ciao
-- 
@Alex (Alessandro Baraldi)
---------------------------------------------------------------------------
http://www.sitocomune.com/
http://www.mantuanet.it/alessandro.baraldi/
---------------------------------------------------------------------------