Sub Test()
    MsgBox FichierExiste("C:\Documents and Settings\dossier\dataBase.mdb")
End Sub


Function FichierExiste(NomFichier As String) As Boolean
    FichierExiste = Dir(NomFichier) <> "" And NomFichier <> ""
End Function

Sub Test()
    MsgBox DossierExiste("C:\Documents and Settings\Nom Dossier")
End Sub


Function DossierExiste(NomDossier As String) As Boolean
    DossierExiste = Dir(NomDossier, vbSystem + vbDirectory + vbHidden) <> ""
End Function

Sub afficherRepertoireParent()
    If ThisWorkbook.Path = "" Then
        MsgBox "Est ce que votre classeur est sauvegardé?"
        Exit Sub
    End If
    
    ChDir (ThisWorkbook.Path)
    ChDir ".."
    MsgBox CurDir
End Sub

Sub afficherRepertoireParent_V02()
    Dim Chemin As String

    If ThisWorkbook.Path = "" Then
        MsgBox "Est ce que votre classeur est sauvegardé?"
        Exit Sub
    End If

    ChDir (ThisWorkbook.Path)
    ChDir ".."
    Chemin = Left(CurDir, InStrRev(CurDir, "\") - 1)
    MsgBox Chemin
End Sub

Sub Test()
    CreationRepertoire "C:\Documents and Settings\dossier", "Archives"
End Sub


Sub CreationRepertoire(DossierParent As String, NomRep As String)
    Dim Chemin As String
    
    'Vérifie si le répertoire existe.
    If Dir(DossierParent, vbDirectory + vbHidden) <> "" Then
        'Vérifie que le dossier à créer n'existe pas déjà dans le répertoire
        If Dir(DossierParent & "\" & NomRep, vbDirectory + vbHidden) = "" Then _
            MkDir DossierParent & "\" & NomRep
    End If
End Sub

Sub repertoireExplorateur_V1()
    Dim Chemin As String
    
    Chemin = "C:\Documents and Settings\dossier"
    Shell "C:\windows\explorer.exe " & Chemin, vbMaximizedFocus
End Sub

Sub repertoireExplorateur_V2()
    Dim Chemin As String
    
    Chemin = "C:\Documents and Settings\dossier"
    ThisWorkbook.FollowHyperlink Chemin
End Sub

Sub repertoireExplorateur_V3()
    Dim Chemin As String
    Dim IE As Object
    
    Chemin = "C:\Documents and Settings\dossier"
    
    Set IE = CreateObject("internetExplorer.Application")
    IE.Navigate Chemin
    IE.Visible = True
End Sub

Sub repertoireExplorateur_V4()
    'Nécessite d'activer la référence "Microsoft Shell Controls and Automation"
    Dim objShell As Shell
    Dim Chemin As String

    Chemin = "C:\Documents and Settings\dossier"

    Set objShell = New Shell
    objShell.Explore (Chemin)
End Sub

Sub BoucleFichiers()
    Dim Chemin As String, Fichier As String
    
    'Définit le répertoire contenant les fichiers
    Chemin = "C:\dossier\"
    
    'Boucle sur tous les fichiers xls du répertoire.
    Fichier = Dir(Chemin & "*.xls")
    'Utilisez la syntaxe suivante pour boucler sur tous les types de fichiers:
    'Fichier = Dir(Chemin & "*.*")
    
    Do While Len(Fichier) > 0
        'écrit le résultat dans la fenêtre d'exécution (Ctrl+G).
        Debug.Print Chemin & Fichier
        Fichier = Dir()
    Loop
End Sub

Sub Test_V1()
    MsgBox NombreFichiers("C:\dossier")
End Sub


Function NombreFichiers(ByVal Dossier As String) As Long
    Dim FSO As Object
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    NombreFichiers = FSO.GetFolder(Dossier).Files.Count
    
    Set FSO = Nothing
End Function

Sub Test_V2()
    'Compte tous les fichiers
    MsgBox NbFich("C:\dossier", "*")
    'Compte tous les fichiers type .txt et .xls    
    MsgBox NbFich("C:\dossier", "txt", "xls")
End Sub

Function NbFich(Chemin As String, ParamArray Termin() As Variant) As Long
'Auteur: Random
Dim Fichier As String
Dim Extension As Variant
Dim Compteur As Long

For Each Extension In Termin
   Fichier = Dir(Chemin & "\*." & Extension)
   Do Until Fichier = ""
   Compteur = Compteur + 1
   Fichier = Dir
   Loop
Next Extension

NbFich = Compteur
End Function

Sub RenommeFichier()
    Dim AncienNom As String, NouveauNom As String
    
    AncienNom = "C:\Documents and Settings\dossier\NomInitial.pdf"
    NouveauNom = "C:\Documents and Settings\dossier\Nom modifié.pdf"
    
    'Vérifie si le fichier à renommer existe.
    If Dir(AncienNom) = "" Then Exit Sub
    'Renomme le fichier
    Name AncienNom As NouveauNom
End Sub

Option Explicit

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type


Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
    (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal _
    dwShareMode As Long, ByVal lpSecurityAttributes As Long, _
    ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes _
    As Long, ByVal hTemplateFile As Long) As Long

Private Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, _
    lpCreationTime As FILETIME, _
    lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long

Private Declare Function SystemTimeToFileTime Lib "kernel32" _
    (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long

Private Declare Function CloseHandle Lib "kernel32" _
    (ByVal hObject As Long) As Long

Private Declare Function LocalFileTimeToFileTime Lib "kernel32" _
    (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long



Sub Test()
    'KPD-Team 1998
    'URL: http://www.allapi.net/
    'KPDTeam@Allapi.net
    '
    'Adapté en VBA le 08/07/2006
    '
    
    Dim m_Date As Date
    Dim lngHandle As Long
    Dim udtFileTime As FILETIME
    Dim udtLocalTime As FILETIME
    Dim udtSystemTime As SYSTEMTIME
    Dim Fichier As String
    
    Fichier = "C:\dossier\nom fichier.txt"
    
    'Le fichier va prendre la date du jour (Now)
    m_Date = Format(Now, "DD-MM-YY")

    udtSystemTime.wYear = Year(m_Date)
    udtSystemTime.wMonth = Month(m_Date)
    udtSystemTime.wDay = Day(m_Date)
    udtSystemTime.wDayOfWeek = Weekday(m_Date) - 1
    udtSystemTime.wHour = Hour(m_Date)
    udtSystemTime.wSecond = Second(m_Date)
    udtSystemTime.wMilliseconds = 0

    ' convertit l'heure systême en heure locale
    SystemTimeToFileTime udtSystemTime, udtLocalTime
    ' convertit l'heure locale en GMT
    LocalFileTimeToFileTime udtLocalTime, udtFileTime
    
    lngHandle = CreateFile(Fichier, GENERIC_WRITE, _
        FILE_SHARE_READ Or FILE_SHARE_WRITE, _
        ByVal 0&, OPEN_EXISTING, 0, 0)
    ' modifie les propriétés date/heure du fichier
    SetFileTime lngHandle, udtFileTime, udtFileTime, udtFileTime
    ' fermeture
    CloseHandle lngHandle
End Sub

Option Explicit

Private Type StructureFichier
     hwnd As Long
     wFunc As Long
     pFrom As String
     pTo As String
     fFlags As Integer
     fAnyOperationsAborted As Boolean
     hNameMappings As Long
     lpszProgressTitle As String
End Type

Private Declare Function SHFileOperation Lib "shell32.dll" Alias _
    "SHFileOperationA" (lpFileOp As StructureFichier) As Long


Private Const FO_DELETE = &H3
'Avec message d'alerte
Private Const FOF_ALLOWUNDO = &H40
'Sans message d'alerte
Private Const FOF_NOCONFIRMATION = &H10


Sub Test()
    EnvoiCorbeille "C:\dossier\NomFichier.xls"
End Sub


Function EnvoiCorbeille(Fichier As String) As Boolean
    Dim Cible As StructureFichier
    Dim lReturn As Long
    
    'Vérifie si le fichier existe.
    If Dir(Fichier) = "" Then Exit Function
    
    With Cible
        .wFunc = FO_DELETE
        .pFrom = Fichier
        .fFlags = FOF_ALLOWUNDO
        'Pour ne pas afficher le message d'alerte:
        '.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
    End With
    
    'Envoie le fichier dans la corbeille
    lReturn = SHFileOperation(Cible)
End Function

Sub CheminRepertoiresSpeciaux()
    'Testé avec Excel2002 & WinXp
    Const Cible = &H5 'Mes Documents
    Dim objShell As Object
    Dim objFolder As Object, objFolderItem As Object
    
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.NameSpace(Cible)
    Set objFolderItem = objFolder.Self
    
    MsgBox objFolderItem.Path
    
    'La liste des constantes pour afficher le chemin des autres dossiers spéciaux de Windows
    '(Const Cible = &H5 'Mes Documents )
    
    '&H5  = My Documents
    '&HC  = (Virtual) \My Documents\
    '&H27 = \My Documents\My Pictures
    '&H2E = \Documents
    '&HD  = \My Documents\My Music
    '&HE   = \My Documents\My Video
    '&H0  = Virtual Desktop
    '&H1  = Virtual Internet Explorer (icon on desktop)
    '&H2  = Start Menu\Programs
    '&H3  = Virtual My Computer\Control Panel
    '&H4  = Virtual My Computer\Printers
    '&H6  = \Favorites
    '&H7  = Start Menu\Programs\Startup
    '&H8  = \Recent
    '&H9  = \SendTo
    '&HA  = Virtual \Recycle Bin
    '&HB  = \Start Menu
    '&H10 = \Desktop
    '&H11 = Virtual My Computer
    '&H12 = Virtual  Network Neighborhood
    '&H13 = \nethood (may dupe My Network Places)
    '&H14 = Virtual windows\fonts
    '&H15 = \templates
    '&H16 = \Start Menu
    '&H17 = \Programs
    '&H18 = \Startup
    '&H19 = \Desktop
    '&H1A = \Application Data
    '&H1B = \PrintHood
    '&H1C = \Local Settings\Applicaiton Data (non roaming)
    '&H1D = nonlocalized startup program group
    '&H1E = (NT) nonlocalized Startup group for all NT users
    '&H1F = (NT) all user's favorite items
    '&H20 = temporary Internet files
    '&H21 = (NT) Internet cookies
    '&H22 = (NT) Internet history items
    '&H23 = \Application Data
    '&H24 = Windows directory or SYSROOT
    '&H25 = GetSystemDirectory()
    '&H26 = \Program Files
    '&H28 = \
    '&H29 = x86 system directory on RISC
    '&H2A = x86 Program Files folder on RISC
    '&H2B = \Program Files\Common
    '&H2C = x86 Program Files Common folder on RISC
    '&H2D = \Templates
    '&H2F = \Start Menu\Programs\Administrative Tools
    '&H30 = \Start Menu\Programs\Administrative Tools
    '&H31 = Virtual Network and dial-up connections folder
    '&H35 = My Music folder for all users
    '&H36 = My Pictures folder for all users
    '&H37 = My Video folder for all users
    '&H38 = System resource directory
    '&H39 = Localized resource directory
    '&H3A = Links to OEM specific apps for all users
    '&H3B = \Local Settings\Application Data\Microsoft\CD Burning
    '&H3D = Virtual Computers Near Me folder

End Sub

Sub tailleElementsCorbeille()
    Dim objShell As Object, objFolder As Object, colItems As Object, objItem As Object
    Dim tailleGDO As String
    Dim Taille As Long, Resultat As Long
    
    'Corbeille
    Const Cible = &HA&
    
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(Cible)
    Set colItems = objFolder.Items
    
    'Boucle sur les éléments de la corbeille
    For Each objItem In colItems
        '3 = taille fichier
        tailleGDO = objFolder.GetDetailsOf(objItem, 3)
        Resultat = Resultat + CLng(Val(tailleGDO))
    Next
    
    MsgBox Resultat & " kb"
End Sub

'*********************
'Sources:
'http://support.microsoft.com/kb/466935/fr
'http://support.microsoft.com/kb/160042/fr
'http://vb.developpez.com/faq/?page=Fichiers#num_version
'
'adapté pour utilisation en VBA Excel
'*********************

Option Explicit

'Renvoie des informations sur la version, pour le fichier spécifié.
'lptstrFilename: adresse du nom de fichier
'dwHandle: handle d'information sur la version
'dwLen: taille du buffer contenant l'information
'lpData: adresse du premier octet du buffer contenant l'information
Private Declare Function GetFileVersionInfo Lib "Version.dll" Alias _
"GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwHandle As Long, _
ByVal dwLen As Long, lpData As Any) As Long

'La fonction GetFileVersionInfoSize détermine si les informations sur la
'version existent. Si c'est le cas, cette fonction retourne la taille du
'buffer contenant l'information et le handle d'information que l'on
'passera à L'API GetFileVersionInfo. Cette dernière permet de récupérer
'les informations sur la version.
'lptstrFilename: adresse du nom de fichier
'lpdwHandle: adresse du handle d'information sur la version
Private Declare Function _
GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" _
(ByVal lptstrFilename As String, lpdwHandle As Long) As Long

'La fonction VerQueryValue retourne la partie d'information sur la version:
'pBlock: adresse du premier octet du buffer contenant l'information
'lpSubBlock: adresse de la partie de l'information qui nous intéresse
'lplpBuffer: adresse du buffer contenant la valeur demandée
'puLen: adresse de la taille du buffer contenant la valeur demandée
Private Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" _
(pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long

Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, _
ByVal Source As Long, ByVal Length As Long)

'Copie une chaîne de caractères dans une autre
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" _
(ByVal lpString1 As String, ByVal lpString2 As Long) As Long

'Renvoie l'adresse de l'executable auquel le fichier est associé
Public Declare Function FindExecutableA Lib "shell32.dll" (ByVal lpFile As String, _
ByVal lpdirectory As String, ByVal lpResult As String) As Long

Public Const MAX_FILENAME_LEN = 256


Public Function DescriptionAppli(ByVal Cible As String, _
    ByVal TypeInfo As String) As String
    
    Dim Buffer As String, Lang_Charset_String As String
    Dim Rc As Long, HexNumber As Long, P As Long
    Dim strVersionInfo As String, strTemp As String
    Dim BufferLen As Long, Dummy As Long
    Dim sBuffer() As Byte
    Dim ByteBuffer(255) As Byte
    
    strVersionInfo = TypeInfo
    
    'Vérifie si les informations sur la version existent.
    BufferLen = GetFileVersionInfoSize(Cible, Dummy)
    If BufferLen < 1 Then Exit Function
    
    ReDim sBuffer(BufferLen)
    Rc = GetFileVersionInfo(Cible, 0&, BufferLen, sBuffer(0))
    If Rc = 0 Then
        DescriptionAppli = False
        Exit Function
    End If
    
    '"\VarFileInfo\Translation" permet de récupérer la langue utilisée et
    'le type de caractère:
    'Par exemple, on peut récupérer la valeur 040C1200 où 040C identifie la
    'langue française et 1200 identifie le jeu de caractères Unicode
    '(Les valeurs des identifiants de langue et de jeu de caractères sont
    'données dans l'aide WIN SDK 32 HELP pour la structure VERSIONINFO).
    Rc = _
    VerQueryValue(sBuffer(0), "\VarFileInfo\Translation", P, BufferLen)
    
    If Rc = 0 Then Exit Function
    
    MoveMemory ByteBuffer(0), P, BufferLen
    
    HexNumber = ByteBuffer(2) + ByteBuffer(3) * &H100 + ByteBuffer(0) * _
        &H10000 + ByteBuffer(1) * &H1000000
        
    Lang_Charset_String = Hex(HexNumber)
        
    Do While Len(Lang_Charset_String) < 8
        Lang_Charset_String = "0" & Lang_Charset_String
    Loop
    
    Buffer = String(255, 0)
    strTemp = "\StringFileInfo\" & Lang_Charset_String & "\" & strVersionInfo
    Rc = VerQueryValue(sBuffer(0), strTemp, P, BufferLen)
    
    If Rc = 0 Then Exit Function
    
    lstrcpy Buffer, P
    Buffer = Mid$(Buffer, 1, InStr(Buffer, Chr(0)) - 1)
    
    DescriptionAppli = Buffer
End Function


'Permet de retrouver l'executable du fichier spécifié.
Function FindExecutable(s As String) As String
    Dim i As Integer
    Dim S2 As String
    
    S2 = String(MAX_FILENAME_LEN, 32) & Chr$(0)
    i = FindExecutableA(s & Chr$(0), vbNullString, S2)
    
    If i > 32 Then
        FindExecutable = Left$(S2, InStr(S2, Chr$(0)) - 1)
        Else
        FindExecutable = ""
    End If
End Function


Sub AfficherInformationsApplication()
    Dim Resultat As String, MonAppli As String, LeFichier As String
    Dim X As Variant
    Dim Tableau As Variant
    Dim i As Byte
    
    'Définit les types d'informatins à récupérer
    Tableau = Array("Name", "comments ", "CompanyName", "FileDescription", _
        "FileVersion", "InternalName", "LegalCopyright", "legalTrademarks", _
        "privateBuild", "OriginalFileName", "ProductName", _
        "productVersionNum", "ProductVersion")
    
    'Affiche un boîte de dialogue pour sélectionner un fichier sur le PC
    X = Application.GetOpenFilename
    'On sort si aucun fichier n'est sélectionné ou si vous avez appuyé
    'sur le bouton "Annuler".
    If X = False Then Exit Sub
    
    LeFichier = X
    'Recherche l'executable associé au fichier sélectionné
    MonAppli = FindExecutable(LeFichier)
    
    'boucle sur les infos à récupérer
    For i = 0 To 12
        Resultat = Resultat & Tableau(i) & " :  " & _
            DescriptionAppli(MonAppli, Tableau(i)) & vbLf
    Next i
    
    'Affiche le resultat de la procedure
    MsgBox Resultat, , "Informations : " & MonAppli
End Sub

Option Explicit


Sub triDecroissant_Fichiers_DateDreation()
    Dim Fichier As String, Chemin As String
    '
    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
    '
    Dim Fso As Scripting.FileSystemObject
    Dim FileItem As Scripting.File
    Dim Tableau()
    Dim Plage As Range
    Dim m As Integer, i As Integer
    Dim z As Byte, Valeur As Byte
    Dim Cible As Variant
       
    '---liste les fichiers du répertoire ---
    Chemin = "C:\Documents and Settings\dossier"
    Fichier = Dir(Chemin & "\*.*")
    'pour filtrer sur un type de fichiers (par exemple xls)
    'Fichier = Dir(Chemin & "\*.xls")
    
    'Boucle sur les fichiers
    Do
        
        m = m + 1
        ReDim Preserve Tableau(1 To 2, 1 To m)
        Tableau(1, m) = Fichier
                       
        Set Fso = CreateObject("Scripting.FileSystemObject")
        Set FileItem = Fso.GetFile(Chemin & "\" & Fichier)
                    
        'Récupère la date de création
        Tableau(2, m) = Left(FileItem.DateCreated, 10)
        'Pour récupérer la date de dernière modification
        'Tableau(2, m) = Left(FileItem.DateLastModified, 10)
        'Pour récupérer la taille du fichier
        'Tableau(2, m) = Left(FileItem.Size, 10)
        
        Fichier = Dir
    Loop Until Fichier = ""
    
    
    '---Trie les fichiers par ordre décroissant de création ---
    Do
        Valeur = 0
        For i = 1 To m - 1
            If CDate(Tableau(2, i)) < CDate(Tableau(2, i + 1)) Then
                For z = 1 To 2
                    Cible = Tableau(z, i)
                    Tableau(z, i) = Tableau(z, i + 1)
                    Tableau(z, i + 1) = Cible
                Next z
                
                Valeur = 1
            End If
        Next i
    Loop While Valeur = 1
         
         
    '--- Transfère les données dans la feuille de calcul ---
    Set Plage = Worksheets("Feuil2").Range("A1")
    Set Plage = Plage.Resize(UBound(Tableau(), 2), UBound(Tableau()))
    Plage = Application.Transpose(Tableau())
    
End Sub

Option Explicit
 
Sub TestListeFichiers()
    Dim Dossier As String
    
    'Définit le répertoire pour débuter la recherche de fichiers.
    '(Attention à ne pas indiquer un répertoire qu contient trop de sous-dossiers ou de
    'fichiers, sinon le temps de traitement va être très long).
    Dossier = "C:\Documents and Settings\mimi\dossier"
    
    'Appelle la procédure de recherche des fichiers
    ListeFichiers Dossier
    
    'Ajuste la largeur des colonnes A:E en fonction du contenu des cellules.
    Columns("A:E").AutoFit
    MsgBox "Terminé"
End Sub
 
 
 
Sub ListeFichiers(Repertoire As String)
    '
    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
        'Dans l'éditeur de macros (Alt+F11):
        'Menu Outils
        'Références
        'Cochez la ligne "Microsoft Scripting RunTime".
        'Cliquez sur le bouton OK pour valider.
    
    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim i As Long
    
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
    
    'Récupère le numéro de la dernière ligne vide dans la colonne A.
    i = Range("A65536").End(xlUp).Row + 1
    
    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files
        'Inscrit le nom du fichier dans la cellule
        Cells(i, 1) = FileItem.Name
        'Ajoute un lien hypertexte vers le fichier
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), _
            Address:=FileItem.ParentFolder & "\" & FileItem.Name
        'Indique la date de création
        Cells(i, 2) = FileItem.DateCreated
        'Indique la date de dernier acces
        Cells(i, 3) = FileItem.DateLastAccessed
        'Indique la date de dernière modification
        Cells(i, 4) = FileItem.DateLastModified
        'Nom du répertoire
        Cells(i, 5) = FileItem.ParentFolder
        
        i = i + 1
    Next FileItem
    
    
    '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
    For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder
 
End Sub

Sub CopierFichier()
    'Copie le fichier dans un autre dossier:
    'syntaxe : FileCopy "source", "destination"
    FileCopy "C:\dossier\general\excel\Classeur.xls", "D:\Classeur.xls"
End Sub

Sub listeConnexionsReseau_Et_CheminsUNC()
    Dim oNetWork As Object, objDisques As Object
    Dim i As Integer
    
    ' l'objet WScript.Network permet de récupérer des informations
    ' au sujet des connexions réseau.
    Set oNetWork = CreateObject("WScript.Network")
    'Renvoie la collection de lecteurs réseaux
    Set objDisques = oNetWork.EnumNetworkDrives
    
    For i = 0 To objDisques.Count - 1 Step 2
        'Ecrit le résultat dans la fenêtre d'exécution (Ctrl+G)
        Debug.Print objDisques.Item(i) & vbTab & objDisques.Item(i + 1)
    Next
End Sub

Sub creerRaccourciBureau()
    'Nécessite d'activer la référence "Windows Script Host Object Model"
    Dim xShell As IWshRuntimeLibrary.wshShell
    Dim Raccourci As IWshRuntimeLibrary.wshShortcut
    Dim dirBureau As String
    
    Set xShell = CreateObject("WScript.Shell")
    'Récupère le chemin du bureau
    dirBureau = xShell.specialFolders("Desktop")
    'Crée le raccourci
    Set Raccourci = xShell.createShortcut(dirBureau & "\monFichier.lnk")
    'Attribue le chemin du classeur contenant cette macro
    Raccourci.targetPath = ThisWorkbook.FullName
    Raccourci.windowStyle = 1
    'attribue un icône
    'Raccourci.iconLocation = "C:\BOOK\GUIDE.ICO"
    Raccourci.Save
End Sub

Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long, _
    ByVal pv As String)

Sub viderMenuDocumentsRecents()
    'C:\Documents and Settings\nom_utilisateur\Recent
    SHAddToRecentDocs 2, vbNullString
End Sub