Garder le dernier fichier sauvegardé

jmkkkk Messages postés 3 Date d'inscription vendredi 10 décembre 2004 Statut Membre Dernière intervention 5 juillet 2005 - 5 juil. 2005 à 22:27
crenaud76 Messages postés 4172 Date d'inscription mercredi 30 juillet 2003 Statut Membre Dernière intervention 9 juin 2006 - 6 juil. 2005 à 00:19
Comment faire un message trè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 ç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é par défaut.



????????????





JMK





PS : Un ingenieur système a qui on promet une formation VB pour janvier 2006. (Oui tout ce code je l'ai pompé.)

o

1 réponse

crenaud76 Messages postés 4172 Date d'inscription mercredi 30 juillet 2003 Statut Membre Dernière intervention 9 juin 2006 29
6 juil. 2005 à 00:19
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 ...
0