Yeah, trovato! :metallica
Visualizzando la finestra del database, cliccare su "Inserisci - Modulo di classe"
Copiare ed incollare nel modulo il seguente codice:
codice:
' CommonDialog class
'
' This module contains an interface to the Common
' Dialog File Open/Save functions. It may be enhanced
' for other Common Dialog functions at a future date.
' This object presents exactly the same interface as
' the Microsoft Common Dialog 6.0 library from Visual
' Basic 6.0 (comdlg32.dll). '
Option Compare Database
Option Explicit
' Values for the Flags property; multiple values can be ORed together.
' In versions of Access prior to Access 2000, comment or delete these
' and use the CommonDialogConstants module (Enum keyword is not
' valid in these versions).
Public Enum CmdlgOpenFlags
cdlOFNAllowMultiselect = &H200
cdlOFNCreatePrompt = &H2000
cdlOFNExplorer = &H80000
cdlOFNFileMustExist = &H1000
cdlOFNHideReadOnly = &H4
cdlOFNNoChangeDir = &H8
cdlOFNNoDereferenceLinks = &H100000
cdlOFNNoNetworkButton = &H20000 ' not documented for common dlg
cdlOFNNoReadOnlyReturn = &H8000
cdlOFNNoValidate = &H100
cdlOFNOverwritePrompt = &H2
cdlOFNPathMustExist = &H800
cdlOFNReadOnly = &H1
cdlOFNShowHelp = &H10
cdlOFNShareAware = &H4000
cdlOFNExtensionDifferent = &H400
End Enum
' Errors raised
Public Enum CmdlgErrors
cdlCancel = 32755 ' user pressed Cancel in dialog
End Enum
' Filter string used for the Open/Save dialog filters (the
' "Files of type" combo box). The string consists of a list of
' filter specs, each of which consists of a pair of elements.
' The first element of each spec is the description to appear
' in the combo box, and the second is a filter pattern. When
' the user selects the description, the corresponding pattern
' is used to filter the list of files in the file list box.
' A pipe character ("|") separates each element of the string.
' Example: "Database Files|*.mdb|All Files|*.*"
Public Filter As String
' Initial Filter to display. This sets/returns the index of the
' currently selected item in the filter combo box.
Public FilterIndex As Long
' Initial directory for the dialog to open in.
' Default = Current working directory.
Public InitDir As String
' Initial file name to populate the dialog with. Default = "".
' Returns the full path name of the selected file.
Public FileName As String
' Returns file name (without path) of file picked
Public FileTitle As String
' Title to appear on the dialog box.
Public DialogTitle As String
' Default extension to append to file if user didn't specify one.
Public DefaultExt As String
' Flags (see constant list) to be used.
' Returns cdlOFNDifferentExtension if extension present and not = DefaultExt
Public Flags As Long
' Maximum length of the file name to be returned
Public MaxFileSize As Integer
' Set to True to raise error 32755 if user cancels dialog box
Public CancelError As Boolean
' Constants used when raising errors
Private Const ErrSource = "MyComDlg.CommonDialog"
' Interface to Win32
Private Type W32_OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustrFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
lngFlags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustrData As Long
lpfnHook As Long
lpTemplateName As Long 'String
End Type
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As W32_OPENFILENAME) As Boolean
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _
"GetSaveFileNameA" (pOpenfilename As W32_OPENFILENAME) As Boolean
Private Sub Class_Initialize()
' Initialize the MaxFileSize to minimum, in case the user doesn't set it
MaxFileSize = 256
End Sub
Public Sub ShowOpen()
' Shows the Open dialog
Dim wofn As W32_OPENFILENAME
Dim intRet As Integer
OFN_to_WOFN wofn
On Error GoTo ShowOpen_Error
intRet = GetOpenFileName(wofn)
On Error GoTo 0
WOFN_to_OFN wofn
If (intRet = 0) And CancelError Then _
Err.Raise cdlCancel, ErrSource, "File open canceled by user"
Exit Sub
ShowOpen_Error:
WOFN_to_OFN wofn
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, _
Err.HelpContext
End Sub
Public Sub ShowSave()
' Shows the Save dialog
Dim wofn As W32_OPENFILENAME
Dim intRet As Integer
OFN_to_WOFN wofn
On Error GoTo ShowSave_Error
intRet = GetSaveFileName(wofn)
On Error GoTo 0
WOFN_to_OFN wofn
If (intRet = 0) And CancelError Then _
Err.Raise cdlCancel, ErrSource, "File save canceled by user"
Exit Sub
ShowSave_Error:
WOFN_to_OFN wofn
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, _
Err.HelpContext
End Sub
Private Sub OFN_to_WOFN(wofn As W32_OPENFILENAME)
' This sub converts from the Microsoft Access structure to the Win32 structure.
' Initialize some parts of the structure.
With wofn
.hwndOwner = Application.hWndAccessApp
.hInstance = 0
.lpstrCustomFilter = vbNullString
.nMaxCustrFilter = 0
.lpfnHook = 0
.lpTemplateName = 0
.lCustrData = 0
.lpstrFilter = ConvertFilterString(Filter)
.nFilterIndex = FilterIndex
If MaxFileSize < 256 Then MaxFileSize = 256
If MaxFileSize < Len(FileName) Then MaxFileSize = Len(FileName)
.nMaxFile = MaxFileSize
.lpstrFile = FileName & String(MaxFileSize - Len(FileName), 0)
.nMaxFileTitle = 260
.lpstrFileTitle = String(260, 0)
.lpstrTitle = DialogTitle
.lpstrInitialDir = InitDir
.lpstrDefExt = DefaultExt
.lngFlags = Flags
.lStructSize = Len(wofn)
End With
End Sub
Private Sub WOFN_to_OFN(wofn As W32_OPENFILENAME)
' This sub converts from the Win32 structure to the Microsoft Access structure.
With wofn
FileName = Left$(.lpstrFile, InStr(.lpstrFile, vbNullChar) - 1)
FileTitle = Left$(.lpstrFileTitle, InStr(.lpstrFileTitle, vbNullChar) - 1)
FilterIndex = .nFilterIndex
Flags = .lngFlags
End With
End Sub
Private Function ConvertFilterString(strFilterIn As String) As String
' Creates a Win32 filter string from a pipe ("|") separated string.
' The string should consist of pairs of filter|extension strings,
' i.e. "Access Databases|*.mdb|All Files|*.*"
' If no extensions exists for the last filter pair, *.* is added.
' This code will ignore any empty strings, i.e. "||" pairs.
' Returns "" if the string passed in is empty.
Dim strFilter As String
Dim intNum As Integer, intPos As Integer, intLastPos As Integer
strFilter = ""
intNum = 0
intPos = 1
intLastPos = 1
' Add strings as long as we find pipe characters
' Ignore any empty strings (not allowed).
Do
intPos = InStr(intLastPos, strFilterIn, "|")
If (intPos > intLastPos) Then
strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos) & vbNullChar
intNum = intNum + 1
intLastPos = intPos + 1
ElseIf (intPos = intLastPos) Then
intLastPos = intPos + 1
End If
Loop Until (intPos = 0)
' Get last string if it exists (assuming strFilterIn was not bar terminated).
intPos = Len(strFilterIn)
If (intPos >= intLastPos) Then
strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos + 1) & vbNullChar
intNum = intNum + 1
End If
' Add *.* if there's no extension for the last string.
If intNum Mod 2 = 1 Then
strFilter = strFilter & "*.*" & vbNullChar
End If
' Add terminating NULL
ConvertFilterString = strFilter & vbNullChar
End Function
Salvare il modulo con il nome "clsCommonDialog".
Infine (per passare all'applicazione pratica) creare il pulsante sfoglia in una form e associate il seguente codice all'evento "Su clic":
codice:
Dim strFileFolderName As String
Dim cmdlgOpenFile As New clsCommonDialog
Const clngFilterIndexAll = 5
cmdlgOpenFile.Filter = "Database Files (MDB)|*.mdb|" & _
"Text Files (TXT)|*.txt|PDF Files (PDF)|*.pdf|" & _
"HTML Files (HTM,HTML)|*.htm*|All Files (*.*)|*.*"
' Set the default file type selection to "All"
' (the fifth item in the above list)
cmdlgOpenFile.FilterIndex = clngFilterIndexAll
cmdlgOpenFile.ShowOpen
strFileFolderName = cmdlgOpenFile.FileName
Alla fine del codice la variabile "strFileFolderName" conterrà il percorso del file selezionato, oppure una stringa vuota (non nulla).
Permessi di invio
Rispondi quotando