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:
ti crei un nuovo modulo di classe e ce lo copi dentro, quando lo salvi lo chiami come vuoi (ex MiaCommonDialog)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
poi lo usi con:
gli altri metodi e proprietà te li lascio scoprirecodice:Dim mcd as MiaCommonDialog set mcd = New MiaCommonDialog mcd.saveAsMode 'altri metodi e proprietà che vuoi mcd.openCommDlg set mcd = nothing
![]()

Rispondi quotando