La finestra di dialogo Apri

Torna a Tutorials

A volte può essere utile gestire la finestra di dialogo Apri, quella cioè che ci permette di navigare tra le nostre cartelle, selezionare il file ed aprirlo con l’applicazione appropriata. Di seguito sono riportati 2 moduli, il primo permette di avviare la finestra di dialogo e gestire alcune proprietà della finestra, il secondo contiene le API.
Dim sFileName As String
Dim udtFileDialog As FileDialog
Dim PercorsoDaAprire As String
Sub ApriExpl()

'
'Imposto le proprietà della finestra
With udtFileDialog
    .CustomFilter = "Tutti i file (*.*)" _
    & Chr$(0) & "*.*" & Chr$(0) & Chr$(0)
    .DefaultExt = "*.*"
    .Title = "Sfoglia"
    .InitialDir = "C:\"
End With
'Salvo il percorso da aprire
PercorsoDaAprire = WinFileDialog(udtFileDialog, 1)
' Se devo aprire un file excel uso il metodo Open _
' altrimenti la funzione ShellExecute
If PercorsoDaAprire <> "" Then
    If Right(PercorsoDaAprire, 3) = "xls" Then
        Workbooks.Open PercorsoDaAprire
    Else
        Call LoadMiscFiles
    End If
End If

End Sub


Sub LoadFile(FileName As String)
    ShellExecute 0, "Open", FileName, "", "", 1
End Sub

Sub LoadMiscFiles()
    LoadFile PercorsoDaAprire
End Sub
	
Di seguito il secondo modulo contenente le WinAPI.
'-------------------------------------------------
' Dichiarazioni WinAPI
'-------------------------------------------------
Private Declare Function GetOpenFileName% _
    Lib "COMDLG32" _
    Alias "GetOpenFileNameA" ( _
        OPENFILENAME As OPENFILENAME _
    )
Private Declare Function GetSaveFileName _
    Lib "comdlg32.dll" _
    Alias "GetSaveFileNameA" ( _
        pOPENFILENAME As OPENFILENAME _
    ) As Long
Private Declare Function GetModuleHandle _
    Lib "Kernel32" _
    Alias "GetModuleHandleA" ( _
        ByVal lpModuleName As String _
    ) As Long
Private Declare Function GetActiveWindow _
    Lib "user32" ( _
    ) As Long
    Declare Function ShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" ( _
        ByVal Hwnd As Long, _
        ByVal lpOperation As String, _
        ByVal lpFile As String, _
        ByVal lpParameters As String, _
        ByVal lpDirectory As String, _
        ByVal nShowCmd As Long _
    ) As Long

'-------------------------------------------------
' Tipi definiti dall'utente
'-------------------------------------------------
Private Type OPENFILENAME
     lStructSize As Long
     hwndOwner As Long
     hInstance As Long
     lpstrFilter As String
     lpstrCustomFilter As Long
     nMaxCustFilter As Long
     nFilterIndex As Long
     lpstrFile As String
     nMaxFile As Long
     lpstrFileTitle As String
     nMaxFileTitle As Long
     lpstrInitialDir As String
     lpstrTitle As String
     Flags As Long
     nFileOffset As Integer
     nFileExtension As Integer
     lpstrDefExt As String
     lCustData As Long
     lpfnHook As Long
     lpTemplateName As Long
End Type
Public Type FileDialog
    Title As String
    CustomFilter As String
    DefaultExt As String
    InitialDir As String
End Type
 
'-------------------------------------------------
' Costanti a livello domodulo
'-------------------------------------------------
'usate per l'API GetOpenFileName
Const OFN_READONLY = &H1
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_SHOWHELP = &H10
Const OFN_ENABLEHOOK = &H20
Const OFN_ENABLETEMPLATE = &H40
Const OFN_ENABLETEMPLATEHANDLE = &H80
Const OFN_NOVALIDATE = &H100
Const OFN_ALLOWMULTISELECT = &H200
Const OFN_EXTENSIONDIFFERENT = &H400
Const OFN_PATHMUSTEXIST = &H800
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_CREATEPROMPT = &H2000
Const OFN_SHAREAWARE = &H4000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOTESTFILECREATE = &H10000
Const OFN_SHAREFALLTHROUGH = 2
Const OFN_SHARENOWARN = 1
Const OFN_SHAREWARN = 0

' DESCRIZIONE:mostra la finestra di dialogo
' Apri per il pulsante Sfoglia...

Function WinFileDialog(typOpenDialog As FileDialog, _
    iIndex As Integer) As String
    Dim OPENFILENAME As OPENFILENAME
    Dim Message$, FileName$, FilesDlgTitle
    Dim szCurDir$, iReturn As Integer
    Dim pathname As String, sAppName As String
    
    'Alloca spazio per le stringhe restituite.
    FileName$ = Chr$(0) & Space$(255) & Chr$(0)
    FilesDlgTitle = Chr$(0) & Space$(255) & Chr$(0)

    'Imposta la struttura dei dati prima di GetOpenFileName
    With OPENFILENAME
        .lStructSize = Len(OPENFILENAME)
        .hwndOwner = GetActiveWindow&
        .lpstrFilter = typOpenDialog.CustomFilter
        .nFilterIndex = 1
        .lpstrFile = FileName$
        .nMaxFile = Len(FileName$)
        .nMaxFileTitle = Len(typOpenDialog.Title)
        .lpstrTitle = typOpenDialog.Title
        .Flags = OFN_FILEMUSTEXIST Or _
            OFN_HIDEREADONLY
        .lpstrDefExt = typOpenDialog.DefaultExt
        .lpstrInitialDir = typOpenDialog.InitialDir
    End With
    
    If iIndex = 1 Then
        iReturn = GetOpenFileName(OPENFILENAME)
    Else
        iReturn = GetSaveFileName(OPENFILENAME)
    End If
    If iReturn Then
        WinFileDialog = Left(OPENFILENAME.lpstrFile, _
        InStr(OPENFILENAME.lpstrFile, Chr$(0)) - 1)
    End If
End Function
	
Per avviare la finestra lancio:"ApriExpl". Buon divertimento.
N.B.: funziona correttamente con Excel 2003, non garantisco il funzionamento per le versioni precedenti. In caso ci sentiamo sul forum .

Cognolato Studio © 2006