IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
logo
Sommaire > Divers > Traitements sur les fichiers
        Copier la base en cours à l'aide d'un batch dos.
        Copier (couper) /Coller des fichiers avec les API
        Créer un nouveau type de fichier
        Envoi/réception de fichier sur un serveur FTP
        Manipuler les fichiers textes
        Recherche de fichiers en spécifiant certaines extensions seulement.
        Recherche récursive d'un fichier
        Rechercher la première occurence d'un fichier dans une arborescence
        Récupérer les informations d'un fichier AVI
        Savoir si un fichier existe en utilisant les API
        Simuler l'appui de n'importe quelle touche du clavier (Exemple avec CAPSLOCK)
        Vérifier si un fichier est déjà ouvert

rechercher
precedent    sommaire    suivant    telecharger


Auteur :
Version : 28/01/2005
Copier la base en cours à l'aide d'un batch dos.
Versions : 97 et supérieures

Pour que ce code fonctionne correctement, vous devez référencer la librairie Microsoft Scripting Runtime (scrrun.dll).
Dim fs As FileSystemObject 
dim f as TextSream 

Set fs = CreateObject("Scripting.FileSystemObject") 
Set f = fs.opentextfile("c:\CopyDB.bat", 2, True) 
f.write "copy " & CurrentDb.Name & " destination" 
f.Close 

Shell "c:\CopyDB.bat"

Auteur : Tofalu
Version : 28/01/2005
Copier (couper) /Coller des fichiers avec les API
Versions : 97 et supérieures

Dans un module :
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" _
(ByVal lpExistingFileName As String, ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long 

Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" _
(ByVal lpFileName As String) As Long 

Function CopierColler(Source as string,Destination as String, _
  NePasEcraser as long) as long 
CopierColler = CopyFile(Source, Destination, NePasEcraser) 
End  Function 

Function CouperColler(Source as string,Destination as String, _
  NepasEcraser as long) as long 
Dim r as long 
r = CopyFile(Source, Destination, NePasEcraser) 
if r then CouperColler=DeleteFile(Source) 
CouperColler=r 
End  Function
Définition des paramètres :
  • Source : Source de la copie
  • Destination : Destination de la copie
  • NePasEcraser : Si ce paramètre vaut zéro, la copie écrase un fichier de même nom s'il existe.


Les fonctions retournent 0 en cas d'échec de l'opération.


Utilisation :
CouperColler("D:\test.txt","d:\test2.txt",0)
Copie test.txt en test2.txt ( en l'écrasant s'il existe déjà), puis supprime test.txt


Auteur : ridan
Version : 05/03/2005
Page de l'auteur
Créer un nouveau type de fichier
Versions : 97 et supérieures

Cet exemple permet de créer un nouveau type de fichier, lui associer un programme et une icône. Ainsi, lorsque l'utilisateur double cliquera sur un de ces fichiers, il sera automatiquement ouvert avec les paramètres renseignés précédemment grâce à ce code.

Le code en lui même est assez simple, il ne s'agit que d'une suite d'insertion de clés et de valeurs dans le registre.

Dans un module, placer le code suivant :
Public Type FileType

    Name As String
    Extension As String
    IconPath As String
    ExePath As String
    
End Type

Public Const HKEY_CLASSES_ROOT = &H80000000

Public Const REG_SZ = 1

Public Const MAX_PATH = 255

Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" ( _
                                        ByVal Hkey As Long, _
                                        ByVal lpSubKey As String, _
                                        phkResult As Long) As Long

Public Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueExA" ( _
                                        ByVal Hkey As Long, _
                                        ByVal lpValueName As String, _
                                        ByVal Reserved As Long, _
                                        ByVal dwType As Long, _
                                        lpData As Any, _
                                        ByVal cbData As Long) As Long
                                        
                                    
                                        
Public Sub Associate(file As FileType)
    
    Dim temp, result, result2 As Long
    
    temp = RegCreateKey(HKEY_CLASSES_ROOT, file.Extension, result)
    temp = RegSetValue(result, "", 0, REG_SZ, ByVal file.Name, Len(file.Name))
    
    temp = RegCreateKey(HKEY_CLASSES_ROOT, file.Name, result)
    
    temp = RegCreateKey(result, "DefaultIcon", result2)
    temp = RegSetValue(result2, "", 0, REG_SZ, ByVal file.IconPath, MAX_PATH)
    
    temp = RegCreateKey(result, "shell\open\command", result2)
    temp = RegSetValue(result2, "", 0, REG_SZ, ByVal file.ExePath, MAX_PATH)

End Sub
Puis, par exemple sur un bouton :
    Dim NewFile As FileType
    NewFile.Name = "Fichier texte"
    NewFile.Extension = ".txt"
    NewFile.IconPath = "c:\monicone.ico"
    NewFile.ExePath = "c:\windows\notepad.exe"
    Associate NewFile

Auteur : Shwin
Version : 28/01/2005
Envoi/réception de fichier sur un serveur FTP
Versions : 97 et supérieures
'------------------- 
'Déclaration des API 
'------------------- 
Private Declare Function InternetCloseHandle Lib "wininet.dll" _
  (ByVal hInet As Long) As Integer 

Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
(ByVal hInternetSession As Long, ByVal sServerName As String, _
ByVal nServerPort As Integer, _
ByVal sUserName As String, ByVal sPassword As String, ByVal lService As Long, _
ByVal lFlags As Long, ByVal lContext As Long) As Long 

Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
 (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _
ByVal sProxyBypass As String, ByVal lFlags As Long) As Long 

Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias _
"FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, _
ByVal lpszDirectory As String) As Boolean 

Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
(ByVal hConnect As Long, ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, ByVal fFailIfExists As Long, _
ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, _
ByRef dwContext As Long) As Boolean 

Private Declare Function FtpPutFile Lib "wininet.dll" Alias _
"FtpPutFileA" (ByVal hConnect As Long, ByVal lpszLocalFile As String, _
ByVal lpszNewRemoteFile As String, ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean 




'Envoi et réception d'un fichier 
Private Sub Commande27_Click() 
Dim HwndConnect As Long 
Dim HwndOpen As Long 
'Ouvre internet 
HwndOpen = InternetOpen("SiteWeb", 0, vbNullString, vbNullString, 0) 
'Connection au site ftp 
HwndConnect = InternetConnect(HwndOpen, "<ftp>", <port>, _
  "<username>", "<password>", 1, 0, 0) 
'positionnement du curseur dans le répertoire 
FtpSetCurrentDirectory HwndConnect, "page_web/documents" 
 'Téléchargement de test.txt 
FtpGetFile HwndConnect, "test.txt", "C:\WINDOWS\Bureau\test.txt", _
  False, 0, &H0, 0

FtpPutFile HwndConnect, "C:\windows\bureau\test.txt", "shwin.txt", &H0, 0 
'Envoi du fichier test.txt et renomme en shwin.txt un coup rend sur le serveur 

InternetCloseHandle HwndConnect 'Ferme la connection 
InternetCloseHandle HwndOpen 'Ferme internet 
End Sub

Auteur : Tofalu
Version : 05/03/2005
Page de l'auteur
Téléchargez le zip
Manipuler les fichiers textes
Attention, pour fonctionner ce code nécessite la référence Microsoft Scripting Runtime.

Cet exemple de code montre la marche à suivre pour manipuler les fichiers textes. N'hésitez surtout pas à télecharger le fichier source au format zip.

Nous utilisons ici plusieurs contrôles :

  • TFichier : une zone de texte contenant le nom du fichier
  • TLigne : une zone de texte dont le contenu sera écrit dans un fichier
  • TTexte : une zone de texte qui affichera le contenu du fichier
  • BOuvrir : un bouton pour selectionner le nom du fichier
  • BAjout : un bouton qui envoit la ligne selectionnée dans le fichier
  • TEcraser : une zone de liste contenant (Ajouter;Ecraser) pour savoir si on ajoute au fichier ou si on ecrase le contenu.

Créer un fichier texte :
Private Function creerfichier() As String
On Error GoTo err
Dim FSO As New Scripting.FileSystemObject
Dim FichText As Scripting.TextStream
Dim Fichier As String
'Recupere le nom du fichier
Fichier = EnregistrerUnFichier(Me.hwnd, _
  "Enregistrer", "MonFichier.txt", CurrentProject.Path)
If Fichier <> "" Then
  'Creer le fichier texte
  Set FichText = FSO.CreateTextFile(Fichier, True)
  TFichier = Fichier
  'Retourne le chemin du fichier
  creerfichier = Fichier
End If
GoTo fin
err:
MsgBox "Impossible de créer le fichier", vbCritical, _
  "Erreur"
fin:
Set FSO = Nothing
Set FichText = Nothing
End Function
La fonction EnregistrerUnFichier est disponible dans la FAQ Access.

Ecrire une ligne dans un fichier texte :
Private Sub EcrireLigne(Fichier As String, _
  Ligne As String, ecraser As Boolean)
On Error GoTo err
Dim FSO As New Scripting.FileSystemObject
Dim FichText As Scripting.TextStream
'Si ecraser alors
If ecraser Then
  'Ouvre le fichier en mode ecriture
  Set FichText = FSO.OpenTextFile(Fichier, ForWriting)
Else
  'Ouvre le fichier en mode ajout
  Set FichText = FSO.OpenTextFile(Fichier, ForAppending)
End If
'Ecrit la ligne
FichText.WriteLine (Ligne)
GoTo fin
err:
MsgBox "Impossible d'ecrire le fichier texte", vbCritical, vbCritical, _
  "Erreur"
fin:
Set FSO = Nothing
Set FichText = Nothing
End Sub
Lire un fichier texte :
Private Sub Bouvrir_Click()
On Error GoTo err
Dim Fichier As String
'Recuper le nom du fichier
Fichier = OuvrirUnFichier(Me.hwnd, "Ouvrir un fichier texte", _
  1, "Fichier Texte", "txt")
If Fichier <> "" Then
  'Affiche le nom du fichier
  TFichier = Fichier
  'Lit le fichier
  lirefichier (Fichier)
End If
Exit Sub
err:
MsgBox "Impossible d'ouvrir le fichier", vbCritical, _
  "Erreur"
End Sub

Private Sub lirefichier(Nom As String)
On Error GoTo err
'Declare le systeme de fichier
Dim FSO As New Scripting.FileSystemObject
'Declare le fichier texte
Dim FichText As Scripting.TextStream
'Ouvre le fichier en lecture
Set FichText = FSO.OpenTextFile(Nom, ForReading)
  'Lit le fichier
  TTexte = FichText.ReadAll
'libere les variable
GoTo fin
err:
MsgBox "Impossible de lire le fichier", vbCritical, _
  "Erreur de lecture"
fin:
Set FichText = Nothing
Set FSO = Nothing
End Sub
La fonction OuvrirUnFichier est disponible dans la FAQ Access ainsi que dans le fichier source zippé.


Auteur : Gaël Donat
Version : 28/01/2005
Recherche de fichiers en spécifiant certaines extensions seulement.
Versions : 2000 et supérieures

L'objet Office FileSearch permet de faire une recherche de fichiers d'un certain type en utilisant la propriété FileType mais les constantes acceptées (MsoFileType) ne sont parfois pas suffisantes : par exemple si l'on souhaite rechercher uniquement des fichiers de type audio (.mp3, .wav etc...). On peut donc utiliser la fonction suivante pour laquelle il faut créer une table Listage_fichier avec le détail suivant :

1 champ "chemin" texte(255)

1 champ "fichier" texte (255)
'Déclaration des API 
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA"_
 (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long 

Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
 (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long 
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" _
 (ByVal lpFileName As String) As Long 
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long 

'Constantes pour les API 
Const MAX_PATH = 260 
Const MAXDWORD = &HFFFF 
Const INVALID_HANDLE_VALUE = -1 
Const FILE_ATTRIBUTE_ARCHIVE = &H20 
Const FILE_ATTRIBUTE_DIRECTORY = &H10 
Const FILE_ATTRIBUTE_HIDDEN = &H2 
Const FILE_ATTRIBUTE_NORMAL = &H80 
Const FILE_ATTRIBUTE_READONLY = &H1 
Const FILE_ATTRIBUTE_SYSTEM = &H4 
Const FILE_ATTRIBUTE_TEMPORARY = &H100 
Const TABLE_FILE = "Listage_fichier" 


'Type pour les API 
Private Type FILETIME 
    dwLowDateTime As Long 
    dwHighDateTime As Long 
End Type 

Private 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 

Function StripNulls(OriginalStr As String) As String 
'Cette fonction permet de supprimer le caractère de fin de chaine d'une chaine 
    If (InStr(OriginalStr, Chr(0)) > 0) Then 
        'On prend les données à gauche de la chaine. 
        OriginalStr = Left$(OriginalStr, InStr(OriginalStr, Chr(0)) - 1) 
    End If 
    'on affecte la nouvelle chaine à l'argument de sortie. 
    StripNulls = OriginalStr 
End Function 

Function FindFilesAPI(path As String, searchstr As String, filecount As Long, _
        dircount As Long, sub_dir As Boolean) 

    Dim filename As String 
    Dim DirName As String 
    Dim dirNames() As String 
    Dim nDir As Integer 
    Dim i As Integer 
    Dim hSearch As Long 
    Dim WFD As WIN32_FIND_DATA 
    Dim Cont As Integer 
    Dim rs As DAO.Recordset 
    
    'On ouvre un curseur sur la table 
    Set rs = CurrentDB.OpenRecordset("SELECT * from listage_fichier") 
    If Right$(path, 1) <> "\" Then path = path & "\" 
    'Si on veut inclure les sous-répertoire (Sub_dir = true) 
    If sub_dir Then 
        ' Recherche des sous répertoires 
        nDir = 0 
        'redimensionne ndir 
        ReDim dirNames(nDir) 
        Cont = True 
        hSearch = FindFirstFile(path & "*", WFD) 
        If hSearch <> INVALID_HANDLE_VALUE Then 
            Do While Cont 
            DirName = StripNulls(WFD.cFileName) 
            If (DirName <> ".") And (DirName <> "..") Then 
                If GetFileAttributes(path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then 
                    dirNames(nDir) = DirName 
                    dircount = dircount + 1 
                    nDir = nDir + 1 
                    ReDim Preserve dirNames(nDir) 
                End If 
            End If 
            Cont = FindNextFile(hSearch, WFD) 
            Loop 
            Cont = FindClose(hSearch) 
        End If 
    End If 

    hSearch = FindFirstFile(path & searchstr, WFD) 
    Cont = True 
    If hSearch <> INVALID_HANDLE_VALUE Then 
        While Cont 
           filename = StripNulls(WFD.cFileName) 
            If (filename <> ".") And (filename <> "..") Then 
                FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) _
                      + WFD.nFileSizeLow 
                filecount = filecount + 1 
                'on ajoute le fichier dans la liste 
                rs.AddNew 
                rs![chemin] = path 
                rs![fichier] = filename 
                rs.Update 
            End If 
            Cont = FindNextFile(hSearch, WFD) 
        Wend 
        Cont = FindClose(hSearch) 
    End If 
    If nDir > 0 Then 
        For i = 0 To nDir - 1 
            FindFilesAPI = FindFilesAPI + FindFilesAPI(path & _
                  dirNames(i) & "\", searchstr, filecount, dircount, sub_dir) 
        Next i 
    End If 
End Function
Dans un formulaire :

- filecount et dircount sont des variables de retour (il ne faut donc pas passer leur valeur directement, ici il faut déclarer des variables type Long).
- sub_dir = true si vous voulez regarder dans les sous-repertoires, et false dans le cas contraire.
Private Sub recherchemp3_Click() 

Dim path As String 
Dim searchstr As String 
Dim filecount As Long 
Dim dircount As Long 
Dim sub_dir As Boolean 

path = "d:\" 
searchstr = "*.txt" 
sub_dir = True 

'on vide la table 
    DoCmd.SetWarnings False 
    CurrentDB.Execute ("DELETE * FROM Listage_fichier") 
    DoCmd.SetWarnings True 

Call FindFilesAPI(path, searchstr, filecount, dircount, sub_dir) 

End Sub
La liste des fichiers trouvés est stockée dans la table Listage_fichier


Auteur : Thierry AIM
Version : 05/03/2005
Page de l'auteur
Téléchargez le zip
Recherche récursive d'un fichier
Versions : 2000 et supérieures

Ce code permet de rechercher un fichier dans un répertoire ou dans un disque complet. Il propose à la fois de choisir le repertoire, d'inclure les sous répertoires de la recherche et de combiner les caractères génériques (tels que *) pour une recherche partielle.

Afin de faire fonctionner ce code, vous devez ajouter la référence Microsoft Scripting Runtime à votre projet.

Code de la recherche :
Private Function ScanFolder(FolderPath As String, _
 Optional Filename As String = "", _
 Optional SubFold As Boolean = True) As Long

' Fonction récursive pour l'exploration des répertoires
On Error Resume Next
  'Declaration des variables
  Dim Element As Variant
  Dim StrPath() As String
  'Recuper le nombre de fichier a scanner
  ScanFolder = fs.GetFolder(FolderPath).Files.Count
  'Parcours le dossier
  For Each Element In fs.GetFolder(FolderPath).Files
    'Si utilisateur clique sur arreter alors stopeer le code
    If Stopper Then Exit Function
    'Affiche le traitement en bas du formulaire
    EResultat.Caption = FolderPath
    'Si on a saisi un fichier à rechercher
    If Filename <> "" Then
      StrPath = Split(Element, "\")
      'si le nom de fichier correspond
      If StrPath(UBound(StrPath)) Like Filename Then
        'Ajoute le nom de fichier à la liste
        Listeresultat.RowSource = Listeresultat.RowSource & Element & ";"
      End If
    Else
      'Ajoute tous les fichiers
      Listeresultat.RowSource = Listeresultat.RowSource & Element & ";"
  End If
    DoEvents
  Next Element
  'Si on inclut les sous dossiers
  If SubFold Then
    'Parcourir chaque sous dossier
    For Each Element In fs.GetFolder(FolderPath).SubFolders
      ScanFolder = ScanFolder + ScanFolder(Element.Path, _
         Filename, SubFold)
    Next Element
  End If
End Function
Principe de fonctionnement :

Le principe est assez simple, on appelle une première fois la fonction en lui passant les paramètres suivant : chemin de recherche, nom du fichier, et un booléen (SubFold) pour savoir s'il on doit inclure les sous-dossiers. Dans une première phase, la fonction examine chaque fichier et si le nom correspond à celui saisit, alors ce nom est ajouté à une zone de liste. Cet ajout est fait en complétant la propriété RowSource de la zone de liste. Dans une seconde phase, si SubFold est vrai, la fonction est rappelée pour chaque sous dossier avec comme paramètre : le chemin du sous dossier, le nom du fichier et le booléen SubFold. Et ainsi de suite pour chaque dossier du sous dossier concerné.
Un autre avantage de cette fonction c'est quelle renvoit le nombre de fichiers parcourus. Ceci peut être trés utile pour effectuer des statistiques.

N'hésitez pas à télecharger le fichier de démonstration pour visualiser le résultat obtenu.


Auteur : Tofalu
Version : 05/03/2005
Page de l'auteur
Rechercher la première occurence d'un fichier dans une arborescence
Cette fonction permet de trouver le premier fichier qui porte le nom passé en paramètre. La recherche se fait dans toute l'arborescence à partir de la racine qui figure dans l'argument root. Cette fonction peut s'avérer trés utile pour rechercher un fichier dans un ensemble de sous-répertoires. Le seul frein à son utilisation est le fait que la rechercher s'arrête dés le premier fichier trouvé.

Dans un module :
Private Declare Function SearchTreeForFile _
Lib "imagehlp" (ByVal RootPath As String, _
ByVal InputPathName As String, _
ByVal OutputPathBuffer As String) As Long

Public Function chercherFichier(NomFichier As String, _
  Root As String)
Dim NomFichier As String, Resultat As Long
'Creer un buffer
tempStr = String(260, 0)
'Lance la recherche
Resultat = SearchTreeForFile(Root, NomFichier, Temp)
If Resultat <> 0 Then _
  chercherFichier = Left$(NomFichier, InStr(1, NomFichier, Chr$(0)) - 1)
End Function
Utilisation :
Msgbox ChercherFichier("Excel.exe","C:\")
Affiche le chemin d'accés du logiciel Excel.


Auteur : Tofalu
Version : 05/02/2005
Page de l'auteur
Récupérer les informations d'un fichier AVI
Versions : 97 et supérieures

Dans un module, placez le code suivant :
Private Const OF_SHARE_DENY_WRITE As Long = &H20
Private Type AVIFileInfo
    dwMaxBytesPerSec As Long
    dwFlags As Long
    dwCaps As Long
    dwStreams As Long
    dwSuggestedBufferSize As Long
    dwWidth As Long
    dwHeight As Long
    dwScale As Long
    dwRate As Long
    dwLength As Long
    dwEditCount As Long
    szFileType As String * 64
End Type

Private Declare Function AVIFileOpen Lib "avifil32" Alias _
"AVIFileOpenA" (ppfile As Long, ByVal szFile As String, _
ByVal mode As Long, pclsidHandler As Any) As Long

Private Declare Function AVIFileRelease Lib "avifil32" _
(ByVal pfile As Long) As Long

Private Declare Function AVIFileInfo Lib "avifil32" Alias _
"AVIFileInfoA" (ByVal pfile As Long, pfi As AVIFileInfo, _
ByVal lSize As Long) As Long

Private Declare Sub AVIFileInit Lib "avifil32" ()

Private Declare Sub AVIFileExit Lib "avifil32" ()

Public Function InformationAVI(NomFichierAVI As String) _
As String

    Dim hFile As Long, AviInfo As AVIFileInfo
    Dim Reponse As String
    'Initialise la librairie AVI
    AVIFileInit
    'Recupere un pointeur vers le fichier
    If AVIFileOpen(hFile, NomFichierAVI, _
     OF_SHARE_DENY_WRITE, ByVal 0&) = 0 Then
        'Lit les informations
        If AVIFileInfo(hFile, AviInfo, Len(AviInfo)) = 0 Then
            Reponse = "Nom du fichier : " & NomFichierAVI & vbCrLf
            Reponse = Reponse & "Dimensions : " & CStr(AviInfo.dwWidth) & _
               "x" & CStr(AviInfo.dwHeight) & vbCrLf
            Reponse = Reponse & "Durée : " & CStr(AviInfo.dwLength) & _
               " Secondes"
        Else
            Reponse = "Impossible d'obtenir les informations."
        End If
        'Libère le pointeur
        AVIFileRelease hFile
    Else
        Reponse = "Impossible d'accéder au fichier"
    End If
    'Quitte le fichier AVI
    AVIFileExit
    InformationAVI = Reponse
End Function
Utilisation :
MsgBox InformationAVI("C:\WINDOWS\clock.avi"), _
vbInformation, "Info AVI"
Ceci affiche une fenêtre avec le nom du fichier, ses dimensions ainsi que sa longueur. Vous remarquerez que bien d'autres informations sont disponibles, comme par exemple le nombre de bytes par seconde : dwMaxBytesPerSec


Auteur : Shwin
Version : 28/01/2005
Savoir si un fichier existe en utilisant les API
Versions : 97 et supérieures

La vitesse d'exécution est sensiblement la même que la fonction .fileExists de la référence "Microsoft Scripting Runtime", sauf que que cette méthode évite d'avoir à utiliser une référence externe. Qui plus est, elle est plus rapide que la fonction dir sur des traitements réccurents puisque cette fonction vise le fichier et s'arrète dés qu'elle le trouve alors que la fonction dir parcourt tout le répertoire même si le fichier a déjà été trouvé.
Public Const INVALID_HANDLE_VALUE = -1 
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _ 
   (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long 
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long 

'---Les types--- 
Public Type FILETIME 
    dwLowDateTime As Long 
    dwHighDateTime As Long 
End Type 

Public 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 

'Savoir si un fichier existe 
Public Function FileExists(source As String) As Boolean 
Dim lpFindFileData As WIN32_FIND_DATA 
Dim hFindFile As Long 
hFindFile = FindFirstFile(source, lpFindFileData) 
FileExists = hFindFile <> INVALID_HANDLE_VALUE 'return vrai ou faux 
FindClose (hFindFile) 
End Function
Utilisation :
msgbox fileExists("C:\fichier.ext") 'retourne vrai si le fichier existe, sinon faux

Auteur : Tofalu
Version : 28/01/2005
Page de l'auteur
Simuler l'appui de n'importe quelle touche du clavier (Exemple avec CAPSLOCK)
Versions : 97 et supérieures

Cette méthode permet de simuler l'appui de n'importe quelle touche. Le nombre passé en paramètre correspond au KeyCode de la touche. (par exemple, 44 pour un imprime écran)
Contrairement à l'instruction sendkeys, cette procédure permet d'appuyer et de relacher une touche ou de la laisser appuyée.
Public Declare Sub keybd Lib "user32" Alias "keybd_event" _
  (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, _
  ByVal dwExtraInfo As Long) 


Public Sub appui_touche(T as long) 
'appuie sur la touche 
keybd T, 0, 0, 0 
'relache la touche 
keybd T, 0, 2, 0 
End Sub
Pour simuler capslock, on aura :
Appui_touche(20)
Pour simuler impr-ecran, on aura :
Appui_touche(44)

Auteur : =JBO=
Version : 12/11/2005
Vérifier si un fichier est déjà ouvert
Versions : Toutes

Un fichier ouvert en lecture seule est considéré comme fermé. Les erreurs (fichier introuvable...) sont reportées dans la procédure appelante.
Public Function IsFileOpen(sFilePath As String) As Boolean 
    Dim nFile As Integer 
    
    On Error GoTo Erreur 
    
    nFile = FreeFile() 
    Open sFilePath For Input Access Read Lock Read Write As nFile 
    Close nFile 
        
    IsFileOpen = False 
    Exit Function 
    
Erreur: 
    If Err.Number = 70 Then 
        ' Si permission refusée, alors fichier déjà ouvert 
        IsFileOpen = True 
    Else 
        ' Sinon, toute autre erreur est répercutée dans la procédure appelante 
        Err.Raise Err.Number, "IsFileOpen" 
    End If 
End Function
Exemple d'utilisation :
If IsFileOpen("C:\MonClasseur.xls") Then
  Msgbox "Fichier ouvert"
End if

rechercher
precedent    sommaire    suivant    telecharger

Valid XHTML 1.1!Valid CSS!

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2005 Maxence Hubiche Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.