1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
|
Sub addFile()
On Error Resume Next
Const BIF_returnonlyfsdirs = &H0001
Const BIF_browseincludefiles = &H4000
Dim objectFile, selectedItem
objectFile = BrowseForFolder( _
"Select a file or folder to copy", _
BIF_returnonlyfsdirs + BIF_browseincludefiles, _
"C:\Users\Toto\Documents")
If objectFile = "-5" Then
MsgBox "Vous ne pouvez pas choisir le répertoire racine", vbCritical, "Répertoire racine"
Else
If objectFile = "-1" Then
MsgBox "Vous ne pouvez pas choisir le répertoire racine", vbCritical, "Répertoire racine"
ElseIf objectFile = "2" then
'MsgBox "Aucun objet sélectionné !", vbInformation, "Info !"
Location.Reload(True)
Else
'MsgBox "Object: " & objectFile
Set selectedItem = WshFso.GetFile(objectFile)
If Err.Number = 53 Then
MsgBox "Vous ne pouvez pas inclure de répertoire", vbCritical, "Répertoire"
Else
inclFileList2.WriteLine objectFile
Location.Reload(True)
End If
End If
End If
End Sub
Function BrowseForFolder(title, flag, dir)
On Error Resume Next
Dim oItem, tmp
'Boîte de dialogue
Set oItem = oShell.BrowseForFolder(&H0, title, flag, dir)
If Err.Number <> 0 Then
If Err.Number = 5 Then
BrowseForFolder= "-5"
Err.Clear
Set oItem = Nothing
Exit Function
End If
End If
'Récupération du chemin
If oItem = "" Then
MsgBox "Annulation / Fichier ou répertoire invalide", vbCritical, "Attention !"
BrowseForFolder = "2"
Else
BrowseForFolder = oItem.ParentFolder.ParseName(oItem.Title).Path
End If
'Gestion annulation
If Err <> 0 Then
If Err.Number = 424 Then 'Annulation
BrowseForFolder = "-1"
Else
Err.Clear
'Si sélection d\'un lecteur - gestion du ":"
tmp = InStr(1, oItem.Title, ":")
If tmp > 0 Then
BrowseForFolder = _
Mid(oItem.Title, (tmp - 1), 2) & "\"
End If
End If
End If
Set oItem = Nothing
On Error GoTo 0
End Function |
Partager