Garder le dernier fichier sauvegardé

Question

Comment faire un message tr&#232;s long :

J'ai un fichier JMTree.bas commme ci.dessous :



Option Explicit

    Type SHITEMID   ' mkid

        cb As Long       ' Size of the ID (including cb itself)

        abID() As Byte  ' The item ID (variable length)

    End Type



    Type ITEMIDLIST   ' idl

        mkid As SHITEMID

    End Type



    Declare Function SHGetPathFromIDList Lib
"shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pIdl As Long, ByVal
pszPath As String) As Long



    Declare Function SHGetSpecialFolderLocation Lib
"shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pIdl As
ITEMIDLIST) As Long

    Public Const NOERROR =  0

    Public Const CSIDL_DESKTOP = &H0

    Public Const CSIDL_PROGRAMS = &H2

    Public Const CSIDL_CONTROLS = &H3

    Public Const CSIDL_PRINTERS = &H4

    Public Const CSIDL_PERSONAL = &H5   ' (Documents folder)

    Public Const CSIDL_FAVORITES = &H6

    Public Const CSIDL_STARTUP = &H7

    Public Const CSIDL_RECENT = &H8   ' (Recent folder)

    Public Const CSIDL_SENDTO = &H9

    Public Const CSIDL_BITBUCKET = &HA

    Public Const CSIDL_STARTMENU = &HB

    Public Const CSIDL_DESKTOPDIRECTORY = &H10

    Public Const CSIDL_DRIVES = &H11

    Public Const CSIDL_NETWORK = &H12

    Public Const CSIDL_NETHOOD = &H13

    Public Const CSIDL_FONTS = &H14

    Public Const CSIDL_TEMPLATES = &H15   ' (ShellNew folder)

    Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)

    Declare Function SHBrowseForFolder Lib "shell32.dll"
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long '
ITEMIDLIST

    Public Type BROWSEINFO   ' bi

        hOwner As Long

        pidlRoot As Long

        pszDisplayName As String

        lpszTitle As String

        ulFlags As Long

        lpfn As Long

        lParam As Long

        iImage As Long

 

    End Type



    Public Const BIF_RETURNONLYFSDIRS = &H1

    Public Const BIF_DONTGOBELOWDOMAIN = &H2

    Public Const BIF_STATUSTEXT = &H4

    Public Const BIF_RETURNFSANCESTORS = &H8

    Public Const BIF_BROWSEFORCOMPUTER = &H1000

    Public Const BIF_BROWSEFORPRINTER = &H2000



    Declare Function DrawIcon Lib "user32" (ByVal hdc As
Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Boolean



Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal
xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth
As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal
hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Boolean

Public Const DI_MASK = &H1

Public Const DI_IMAGE = &H2

Public Const DI_NORMAL = &H3

Public Const DI_COMPAT = &H4

Public Const DI_DEFAULTSIZE = &H8



Declare Function SHGetFileInfo Lib "Shell32" Alias "SHGetFileInfoA"
(ByVal pszPath As Any, ByVal dwFileAttributes As Long, psfi As
SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long



Public Const FILE_ATTRIBUTE_READONLY = &H1

Public Const FILE_ATTRIBUTE_HIDDEN = &H2

Public Const FILE_ATTRIBUTE_SYSTEM = &H4

Public Const FILE_ATTRIBUTE_DIRECTORY = &H10

Public Const FILE_ATTRIBUTE_ARCHIVE = &H20

Public Const FILE_ATTRIBUTE_NORMAL = &H80

Public Const FILE_ATTRIBUTE_TEMPORARY = &H100

Public Const FILE_ATTRIBUTE_COMPRESSED = &H800



Public Const MAX_PATH = 260



Type SHFILEINFO   ' shfi

    hIcon As Long

    iIcon As Long

    dwAttributes As Long

    szDisplayName As String * MAX_PATH

    szTypeName As String * 80

End Type



Public Const SHGFI_LARGEICON = &H0&

Public Const SHGFI_SMALLICON = &H1&

Public Const SHGFI_OPENICON = &H2&

Public Const SHGFI_SHELLICONSIZE = &H4&

Public Const SHGFI_PIDL = &H8&

Public Const SHGFI_USEFILEATTRIBUTES = &H10&

Public Const SHGFI_ICON = &H100&

Public Const SHGFI_DISPLAYNAME = &H200&

Public Const SHGFI_TYPENAME = &H400&

Public Const SHGFI_ATTRIBUTES = &H800&

Public Const SHGFI_ICONLOCATION = &H1000&

Public Const SHGFI_EXETYPE = &H2000&

Public Const SHGFI_SYSICONINDEX = &H4000&

Public Const SHGFI_LINKOVERLAY = &H8000&

Public Const SHGFI_SELECTED = &H10000



Public Function BrowseForDirectory(argForm As Form, argFolder As Integer, argDirectory As String, argTitle As String) As Integer

    Dim BI As BROWSEINFO

    Dim nFolder As Long

    Dim IDL As ITEMIDLIST

    Dim pIdl As Long

    Dim sPath As String

    Dim SHFI As SHFILEINFO

  

    BrowseForDirectory = False

    On Error GoTo BrowseForDirectory_Error

    With BI

    nFolder = argFolder

    If (SHGetSpecialFolderLocation(ByVal argForm.hWnd, ByVal nFolder, IDL) = NOERROR) Then

        .pidlRoot = IDL.mkid.cb

    End If

    .lpszTitle = argTitle

    End With

    pIdl = SHBrowseForFolder(BI)



    sPath = String$(MAX_PATH, 0)

    SHGetPathFromIDList ByVal pIdl, ByVal sPath

    argDirectory = Left(sPath, InStr(sPath, vbNullChar) - 1)

    SHGetFileInfo ByVal pIdl, 0&, SHFI, Len(SHFI), SHGFI_PIDL Or SHGFI_ICON Or SHGFI_SMALLICON

    SHGetFileInfo ByVal pIdl, 0&, SHFI, Len(SHFI), SHGFI_PIDL Or SHGFI_ICON

    CoTaskMemFree pIdl

    BrowseForDirectory = True

    Exit Function

BrowseForDirectory_Error:

    Exit Function

End Function



 Avec un bouton, tout pas beau, comme &#231;a : 



Private Sub cmdOutput_Click()

    Dim wrkDirectory As String

    On Error Resume Next

    If (BrowseForDirectory(Me, 0, wrkDirectory, "Select the Output Directory")  = True) Then

        Text2.Text = wrkDirectory

    End If

End Sub



Et j'aimerai qu'il garde le chemin et le dernier fichier sauvegard&#233; par d&#233;faut.



????????????





JMK





PS : Un ingenieur syst&#232;me a qui on promet une formation VB pour janvier 2006. (Oui tout ce code je l'ai pomp&#233;.)

o

crenaud76 · Answer

Je pense que ce bout de code issu de deux module sque j'ai sous le coude devrait t'aider ...




'-------------- Premier module --------------
Option Explicit 

Private Type BrowseInfo
    hWndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type

Private Const BIF_NEWDIALOGSTYLE = &H40
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const MAX_PATH = 260

Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Private Function GetAddress(Adr As Long) As Long
    GetAddress = Adr
End Function

Public Function ShowBrowseForFolderDlg(ByVal hwnd As Long, ByVal Msg As String, Optional ByVal InitDir As String) As String
Dim iNull As Integer, lpIDList As Long, sPath As String, udtBI As BrowseInfo

    With udtBI
        .hWndOwner = hwnd
        .lpszTitle = lstrcat(Msg, "")
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_NEWDIALOGSTYLE
        .lpfnCallback = GetAddress(AddressOf BrowseForFolderCallBackFunc)
    End With
    BFFInitialPath = InitDir
    lpIDList = SHBrowseForFolder(udtBI)
    If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        SHGetPathFromIDList lpIDList, sPath
        CoTaskMemFree lpIDList
        iNull = InStr(sPath, vbNullChar)
        If iNull Then
            sPath = Left$(sPath, iNull - 1)
        End If
    End If

    ShowBrowseForFolderDlg = sPath
End Function


'-------------- Second module --------------
Option Explicit

Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SETSELECTIONA = (WM_USER + 102)

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public BFFInitialPath As String

Public Function BrowseForFolderCallBackFunc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long  'callback-funktion für ordnerwahl-dialog
    Select Case uMsg
       Case BFFM_INITIALIZED
            If Len(BFFInitialPath) > 0 Then
                SendMessage hwnd, BFFM_SETSELECTIONA, 1, ByVal BFFInitialPath
            End If
    End Select
End Function

Appelle ensuite la fonction ShowBrowseForFolderDlg() en lui indiquant en dernier argument le dossier à ouvrir dans la boite de choix de dossier à l'ouverture ...

Garder le dernier fichier sauvegardé

1 réponse

Discussions similaires