ciao miss, se non vuoi usare componenti esterni ti giro questa classe che avevo scritto tempo fa partendo da una funzione per la gestione dei commondialog:
codice:
Option Compare Database
Option Explicit
Private Type adh_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
Private strDlgTitle As String
Private strFile As String
Private strDir As String
Private mode As Integer
Private defPath As String
Private fileFilters As String
Private fullFilePath As String
Private fullDirPath As String
Private Declare Function adh_accOfficeGetFileName Lib "msaccess.exe" Alias "#56" (gfni As adh_accOfficeGetFileNameInfo, ByVal fOpen As Integer) As Long
Private Sub Class_Initialize()
strDlgTitle = "Apri File o Cartella"
strFile = ""
strDir = ""
mode = -1
defPath = ""
fullFilePath = ""
resetFilters
addFileFilter "Tutti i files", "*.*"
End Sub
Public Sub openFileMode()
mode = -1
End Sub
Public Sub saveAsMode()
mode = 0
End Sub
Public Property Let setDialogTitle(sTitle As String)
strDlgTitle = sTitle
End Property
Public Property Let setDefaultPath(sPath As String)
defPath = sPath
End Property
Public Property Let setDefaultFileName(sFileName As String)
strFile = sFileName
End Property
Public Property Let setDefaultDirName(sDirName As String)
strDir = sDirName
End Property
Public Sub addFileFilter(fileDescription As String, fileExtension As String)
If fileFilters & "" = "" Then
fileFilters = fileDescription & " (" & fileExtension & ")" & "|" & fileExtension
Else
fileFilters = fileFilters & "|" & fileDescription & " (" & fileExtension & ")" & "|" & fileExtension
End If
End Sub
Public Sub resetFilters()
fileFilters = ""
End Sub
Public Property Get getFileFullPath() As String
On Error GoTo errorPath
If Trim(fullFilePath & "") = "" Then GoTo errorPath
getFileFullPath = fullFilePath
Exit Property
errorPath:
getFileFullPath = -1
End Property
Public Property Get getDirFullPath() As String
On Error GoTo errorPath
If Trim(fullDirPath & "") = "" Then GoTo errorPath
getDirFullPath = fullDirPath
Exit Property
errorPath:
getDirFullPath = -1
End Property
Public Property Get getFileDirPath() As String
On Error GoTo errorPath
If fullFilePath & "" = "" Then GoTo errorPath
getFileDirPath = Left$(fullFilePath, InStrRev(fullFilePath, "\"))
Exit Property
errorPath:
getFileDirPath = -1
End Property
Public Property Get getFileName() As String
On Error GoTo errorName
If fullFilePath = "" Then GoTo errorName
getFileName = Right$(fullFilePath, Len(fullFilePath) - InStrRev(fullFilePath, "\"))
Exit Property
errorName:
getFileName = -1
End Property
Private Function adhOfficeGetFileName(gfni As adh_accOfficeGetFileNameInfo, ByVal fOpen As Integer) As Long
Dim lng As Long
With gfni
.strAppName = RTrim$(.strAppName) & vbNullChar
.strDlgTitle = RTrim$(.strDlgTitle) & vbNullChar
.strOpenTitle = RTrim$(.strOpenTitle) & vbNullChar
.strFile = RTrim$(.strFile) & vbNullChar
.strInitialDir = RTrim$(.strInitialDir) & vbNullChar
.strFilter = RTrim$(.strFilter) & vbNullChar
SysCmd acSysCmdClearHelpTopic
lng = adh_accOfficeGetFileName(gfni, fOpen)
.strAppName = RTrim$(adhTrimNull(.strAppName))
.strDlgTitle = RTrim$(adhTrimNull(.strDlgTitle))
.strOpenTitle = RTrim$(adhTrimNull(.strOpenTitle))
.strFile = RTrim$(adhTrimNull(.strFile))
.strInitialDir = RTrim$(adhTrimNull(.strInitialDir))
.strFilter = RTrim$(adhTrimNull(.strFilter))
End With
adhOfficeGetFileName = lng
End Function
Private Function adhTrimNull(strVal As String) As String
Dim intPos As Integer
intPos = InStr(strVal, vbNullChar)
If intPos > 0 Then
adhTrimNull = Left$(strVal, intPos - 1)
Else
adhTrimNull = strVal
End If
End Function
'Opens commom dialog box for a directory
Public Sub OpenCommDlgDir()
On Error GoTo OpenCommDlgDir_Err
Dim gfni As adh_accOfficeGetFileNameInfo
With gfni
.lngFlags = &H20
.strDlgTitle = strDlgTitle & ""
.strOpenTitle = "&OK" & ""
.strInitialDir = strDir & ""
End With
OpenCommDlgDir = ""
'mode : -1 for Open; 0 for Save
If adhOfficeGetFileName(gfni, mode) = 0 Then
fullDirPath = Trim(gfni.strFile)
End If
Exit Sub
OpenCommDlgDir_Err:
MsgBox Err.Description & Chr(13) & Chr(10) & " ErrorNum:" & str(Err), 48
Exit Sub
End Sub
Public Sub OpenCommDlg()
On Error GoTo OpenCommDlg_Err
Dim stdir As String, dbFilename As String
Dim gfni As adh_accOfficeGetFileNameInfo
'Make sure not to pass in Null values.
With gfni
.strDlgTitle = strDlgTitle & ""
.strFile = strFile & ""
.strInitialDir = defPath & ""
.strFilter = fileFilters & ""
.strOpenTitle = "&OK" & ""
End With
'mode : -1 for Open; 0 for Save
If adhOfficeGetFileName(gfni, mode) = 0 Then
dbFilename = Trim(gfni.strFile)
End If
fullFilePath = dbFilename
Exit Sub
OpenCommDlg_Err:
MsgBox Err.Description & Chr(13) & Chr(10) & " ErrorNum:" & str(Err), 48
Exit Sub
Resume Next
End Sub
ti crei un nuovo modulo di classe e ce lo copi dentro, quando lo salvi lo chiami come vuoi (ex MiaCommonDialog)
poi lo usi con:
codice:
Dim mcd as MiaCommonDialog
set mcd = New MiaCommonDialog
mcd.saveAsMode
'altri metodi e proprietà che vuoi
mcd.openCommDlg
set mcd = nothing
gli altri metodi e proprietà te li lascio scoprire
VVoVe:
): muscolosone!
Permessi di invio
Rispondi quotando