Page 1 sur 1
Selection d'un fichier
Publié:
16 Mai 2007 à 20:21par 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
Publié:
05 Nov 2007 à 17:49par 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