Selection d'un fichier

[Michael DELIQUE]

Code : Tout sélectionner

Public Function FileSearch_API(sSearch As String, sFichier As String) As String
   
%REM
'Variables API pour la fonction FileSearch_API
Const MAX_PATH = 260
Const INVALID_HANDLE_VALUE = -1

Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type
Type WIN32_FIND_DATA
   dwFileAttributes As Long
   ftCreationTime As FILETIME
   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Long
   nFileSizeLow As Long
   dwReserved0 As Long
   dwReserved1 As Long
   cFileName As String * MAX_PATH
   cAlternate As String * 14
End Type

Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( Byval lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( Byval hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
%END REM
   
   'Déclaration  Variable
   Dim iNum As Long
   Dim i As Long
   Dim iDeb As Long
   Dim hFile As Long
   Dim tFindFile As WIN32_FIND_DATA
   Dim bTrouve As Variant
   Dim pos As Integer
   Dim tmpSearch  As String
   
   On Error Goto ErreurFileSearch_API
   
   hFile = findfirstfile(sSearch + "\*.*", tFindFile)
   bTrouve = hFile <> INVALID_HANDLE_VALUE
   Do While bTrouve
      If tFindFile.dwFileAttributes = 32 Or tFindFile.dwFileAttributes = 1Then
         pos = Instr(tfindfile.cfilename, Chr$(0))
         tmpSearch = Left$(tfindfile.cfilename, pos - 1)
         
         If tmpSearch = sFichier Or tmpSearch = Ucase(sFichier) Then
            FileSearch_API = sSearch & "\" & tmpSearch
            Exit Do
         End If
      End If
      inum = inum + 1
      bTrouve = FindNextFile(hFile, tFindFile)
   Loop
   
   Exit Function
ErreurFileSearch_API:
   Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"   
   FileSearch_API = ""
   Exit Function
End Function

[Michael DELIQUE]

une autre version

Code : Tout sélectionner

Public Function GetFile_API As String
      'cette fonction permet de sélectionne un fichier via le selecteur de ficheir de windows
%REM
'variable API pour la fonction GetFile
Type tagOPENFILENAME
   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 Const OFN_FILEMUSTEXIST = &H1000

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (OPENFILENAME As tagOPENFILENAME)  As Long
%END REM
   
   'Déclaration des Variables   
   Dim OPENFILENAME As tagOPENFILENAME
   Dim CurrentDirectory As String
   Dim FileName As String
   Dim FileTitle As String
   Dim Titre As String
   Dim nbAPIResults As Integer
   
   On Error Goto ErreurGetFile_API
   
   Titre = " SELECTION FICHIER" & Chr$(0)
   
     'Initialisation des variable
   FileName = Chr$(0) & Space$(255) & Chr$(0)
   FileTitle = Space$(255) & Chr$(0)
   
   'récupere le répertoire par défaut
   CurrentDirectory = Curdir$ & Chr$(0)
   
     'Initialise la structure avant l'appel de la fonction API GetOpenFileName
   OPENFILENAME.lStructSize = Len(OPENFILENAME)
   
   OPENFILENAME.hwndOwner = 0&
   OPENFILENAME.nFilterIndex = 1
   OPENFILENAME.lpstrFile = FileName
   OPENFILENAME.nMaxFile = Len(FileName)
   OPENFILENAME.lpstrFileTitle = FileTitle
   OPENFILENAME.nMaxFileTitle = Len(FileTitle)
   OPENFILENAME.lpstrTitle = Titre
   OPENFILENAME.Flags = OFN_FILEMUSTEXIST
   OPENFILENAME.hInstance = 0
   OPENFILENAME.lpstrCustomFilter = 0
   OPENFILENAME.nMaxCustFilter = 0
   OPENFILENAME.lpstrInitialDir = CurrentDirectory
   OPENFILENAME.nFileOffset = 0
   OPENFILENAME.nFileExtension = 0
   OPENFILENAME.lCustData = 0
   OPENFILENAME.lpfnHook = 0
   OPENFILENAME.lpTemplateName = 0
   
   'Appel de la fonction de selection
   nbAPIResults = GetOpenFileName(OPENFILENAME)   
'   FileName = Cstr( OPENFILENAME.lpstrFile )
'   FileTitle = Cstr( OPENFILENAME.lpstrFileTitle )   
   
   GetFile_API = Cstr( OPENFILENAME.lpstrFile )
   Exit Function
ErreurGetFile_API:
   Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   GetFile_API = ""
   Exit Function
End Function