Créer dossier Windows à partir d'une liste Excel

Bonsoir à tous,

J'envoie quotidiennement par mail plusieurs dizaines de fichiers PDF, pour cela je dois d'abord rechercher et copier ces documents manuellement, depuis l'explorateur Windows, avant de pouvoir faire un dossier compressé de l'ensemble et le joindre au mail.

Les éléments à envoyer par mail se présentent initialement sous la forme d'une liste/tableau Excel. Je voudrais savoir s'il est possible de créer un dossier, comprenant tous les fichiers à envoyer, à partir de cette liste Excel. L'idéal serait de pouvoir faire une sélection par correspondance approximative.

Merci d'avance pour vos réponses.

Bonsoir,

Je voudrais savoir s'il est possible de créer un dossier, comprenant tous les fichiers à envoyer, à partir de cette liste Excel. L'idéal serait de pouvoir faire une sélection par correspondance approximative.

Ma réponse est simple, oui c'est possible

Bonne soirée

Ah merci bien, je suis heureux de savoir que cela fait parti du champ des possibles.

Maintenant, est ce que je pourrais savoir par quel moyen ? Faut il faire un exécutable ou peut on rester dans Excel ?

Re,

En restant dans Excel et avec VBA bien entendu

Un code que j'utilisais qui doit être encore valable

Sub ZipRepertoire(sPath As String, sNomDossier As String)
  'Source : http://www.codecomments.com/archive299-2006-2-295877.html
  Const ForReading = 1, ForWriting = 2, ForAppending = 8

  Dim Source, Destination, MyHex, MyBinary, i
  Dim oShell, oApp, oFolder, oCTF, oFile
  Dim oFileSys

  'Spécifiez le répertoire
  If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
  Source = sPath & sNomDossier & "\"
  Destination = sPath & sNomDossier & ".zip"
  ' Si le fichier existe déjà, on le supprimer
  On Error Resume Next
  If Dir(Destination) <> "" Then Kill Destination
  On Error GoTo 0

  MyHex = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)

  For i = 0 To UBound(MyHex)
    MyBinary = MyBinary & Chr(MyHex(i))
  Next
  Set oShell = CreateObject("WScript.Shell")
  Set oFileSys = CreateObject("Scripting.FileSystemObject")
  'Création de la base du fichier zip.
  Set oCTF = oFileSys.CreateTextFile(Destination, True)
  oCTF.Write MyBinary: oCTF.Close: Set oCTF = Nothing
  ' Créer une instance
  Set oApp = CreateObject("Shell.Application")
  Set oFolder = oApp.Namespace(Source)
  If Not oFolder Is Nothing Then
    oApp.Namespace(Destination).CopyHere oFolder.Items
  End If
  Set oFile = Nothing
  On Error Resume Next
  Do While (oFile Is Nothing)
    'Attention: provoque une erreur 70 si un des fichiers à zipper
    'est toujours ouvert.
    Set oFile = oFileSys.OpenTextFile(Destination, ForAppending, False)
    If Err.Number <> 0 Then
      Err.Clear
    End If
  Loop
  Set oFile = Nothing
  Set oFileSys = Nothing
End Sub

A adapter

Merci pour le code.

Je dois l'insérer sous forme d'un module ? Quels sont les prérequis du fichier Excel comprenant cette formule, il doit comporter la liste des fichiers recherchés ?

Le code ci-dessous fait partiellement l'affaire :

Sub copyfiles()
'Updateby Extendoffice
    Dim xRg As Range, xCell As Range
    Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
    Dim xSPathStr As Variant, xDPathStr As Variant
    Dim xVal As String
    On Error Resume Next
    Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xSFileDlg.Title = "Please select the original folder:"
    If xSFileDlg.Show <> -1 Then Exit Sub
    xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
    Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xDFileDlg.Title = "Please select the destination folder:"
    If xDFileDlg.Show <> -1 Then Exit Sub
    xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
    For Each xCell In xRg
        xVal = xCell.Value
        If TypeName(xVal) = "String" And xVal <> "" Then
            FileCopy xSPathStr & xVal, xDPathStr & xVal
        End If
    Next
End Sub

Cependant, la recherche se fait par correspondance exacte "nom du fichier" + extension.

Et je ne sais absolument pas quoi modifier pour que la recherche se fasse par correspondance approximative, le tout sans tenir compte de l'extension.

up