Créer un dossier sur le bureau

Soyez le premier à donner votre avis sur cette source.

Snippet vu 16 676 fois - Téléchargée 8 fois


Contenu du snippet

Private Const DESKTOP As Long = &H0
Private Type SHITEMID
    SHItem As Long
    itemID() As Byte
End Type
Private Type ITEMIDLIST
    shellID As SHITEMID
End Type
Private Declare Function MakeSureDirectoryPathExists Lib  "imagehlp.dll" (ByVal lpPath As String) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal shidl As Long, ByVal shPath As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib  "shell32.dll" (ByVal hWnd As Long, ByVal folderid As Long, shidl As ITEMIDLIST) As  Long

Function CreateForderOnDesktop(ByVal sFolder As String) As String
'   retourne vide si  échec, sinon le nom du chemin complet
    CreateForderOnDesktop = vbNullString
    Dim tIDL As ITEMIDLIST, sBuffer As String, sRet As String
    
    If LenB(sFolder) Then
'       chemin  DESKTOP
        sBuffer = Space$(256)
        If SHGetSpecialFolderLocation(App.hInstance, DESKTOP, tIDL) =  0 Then
            If SHGetPathFromIDList(ByVal tIDL.shellID.SHItem, ByVal sBuffer) Then
                sRet = Left$(sBuffer, InStr(sBuffer, Chr$(0)) -  1)
                If Not (RightB$(sRet, 2) = "\") Then sRet = sRet & "\"
                sRet = sRet & sFolder & "\"
'               crée le dossier.  pas d'erreur s'il existe puisqu'il sera toujours existant  ensuite
                If Not (MakeSureDirectoryPathExists(sRet) = 0) Then  CreateForderOnDesktop =  sRet
            End If
        End If
    End If
End Function


Compatibilité : VB6, VBA

Disponible dans d'autres langages :

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.