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