Ajouter "tout caractère" à un nom de fichier

Le 08/09/2020 à 16:18

Bonjour,

Je travaille sur une macro qui traite un fichier préalablement téléchargé par l'utilisateur (exemple : DataExtraction.csv). Si l'extraction est faite plusieurs fois, le fichier peut s'appeler DataExtraction(1).csv. Y a-t-il un moyen d'utiliser la commande Windows("DataExtraction.csv").Activate en incluant les variantes numérotées du type Windows("DataExtraction*.csv").Activate ?

Merci d'avance !

Le 08/09/2020 à 16:37

Bonjour,

Au lieu de donner une ligne, peux-tu montrer le code complet ? Le conseil sera efficace. Car on ne sait pas à quel contexte ce code intervient.

Le 08/09/2020 à 17:37

Comme ça ?

Sub Import()

'ouverture de l'extraction
     NomFic = Application.GetOpenFilename(, , "Importation des données")
        If NomFic <> False Then
            Workbooks.OpenText Filename:=NomFic, DataType:=1, Semicolon:=True, local:=True
        End If
'Copier le fichier CSVExtraction.csv dans la feuille "donnees"
Windows("DataExtraction.csv").Activate
    Range("C2:D140,I2:I140,N2:P140").Select
    Selection.Copy
    Windows("ExportData.xlsm").Activate
    Sheets("donnees").Select
    Range("B2").Select    
    ActiveSheet.Paste

'Filtrer
    Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$G$194").AutoFilter Field:=1, Criteria1:="<>"
    Range("A1:G500").Select
    Selection.Copy
    Sheets("Contacts").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select

'fermeture du fichier CSVExtraction.csv
  Windows("DataExtraction.csv").Activate
  ActiveWorkbook.Close

'définition du répertoire de destination
Chemin = ActiveWorkbook.Path
'sauvegarde du fichier ExportFinal.csv
ActiveWorkbook.SaveAs Filename:=Chemin & "\ExportFinal.csv", FileFormat:=xlCSV, _
          CreateBackup:=False

'fermeture
MsgBox ("Le fichier ExportFinal.csv a été enregistré au même endroit que le fichier ExportData.xlsm qui vous a permis de le créer." & Chr(10) & Chr(10) & "Cliquer sur OK pour quitter Excel.")
  Workbooks.Open Filename:=Chemin & "\ExportData.xlsm"
  Windows("ExportFinal.csv").Activate
  ActiveWorkbook.Close False

End Sub
Le 09/09/2020 à 00:13

Bonsoir Gab,

Si j'ai bien compris, vous cherchez à effectuer ce que vous faites déjà avec un fichier (DataExtraction) avec plusieurs fichiers commençant par ce même nom.

J'ai un essai avec une boucle qui est censée faire les opérations que vous faisiez mais sur chacun de ces fichiers "DataExtraction" tant qu'il en existe. Je ne suis pas trop sûr du résultat car je ne l'ai pas testé mais les problèmes éventuels devraient principalement résulter d'une mauvaise syntaxe...

Sub Import()

Dim WbExport as workbook, WbExtrac as workbook
Dim NomFic$

Set WbExport = workbooks("ExportData.xlsm") 'classeur servant à l'export (tampon?)

NomFic = Dir("*DataExtraction*.csv") 'répertorie fichier csv contenant "DataExtraction"
while NomFic <> "" 'tant que le résultat n'est pas vide (càd qu'il existe un fichier contenant "DataExtraction")

    Workbooks.OpenText Filename:=NomFic, DataType:=1, Semicolon:=True, local:=True 'ouverture de ce fichier (voir s'il faut chemin complet)
    Set WbExtrac = ActiveWorkbook 'Affectation du classeur DataExtraction

    'WbExport.Sheets("donnees").cells.clearcontents '??? effacer au préalable les contenus ? (quid ranges tailles différentes)
    'WbExport.Sheets("Contacts").cells.clearcontents '??? effacer au préalable les contenus ?

    With WbExtrac
        .Range("C2:D140,I2:I140,N2:P140").Copy destination:=WbExport.Sheets("donnees").Range("B2") 'copier/coller en B2 de données
        .Close savechanges:=true 'fermeture
    end with

    With WbExport
        .Sheets("donnees").Range("$A$1:$G$194").AutoFilter Field:=1, Criteria1:="<>" 'Filtrer (? pourquoi A1:G194 ?)
        .Sheets("donnees").Range("A1:G500").Copy 'copier
        .Sheets("Contacts").Range("A1").PasteSpecial Paste:=xlPasteValues 'coller valeurs dans contacts
        .SaveAs Filename:="ExportFinal_" & format(Now, "YYMMDD-HHMMSS") & ".csv", FileFormat:=xlCSV, CreateBackup:=False 'sauvegarde sous nv csv "ExportFinal avec Horodatage" pour éviter bug ou écrasement du fichier précédent
    end with

    'kill WbExtrac.fullname '? pour détruire le csv DataExtraction retraité
    'Name WbExtrac.fullname as WbExtract.Pathname & "\" & "DonneesExtraites_" & format(Now, "YYMMDD-HHMMSS") & ".csv" 'pour renommer fichier Data traité

'MsgBox "Le fichier ExportFinal.csv a été enregistré au même endroit que le fichier ExportData.xlsm qui vous a permis de le créer." _
& Chr(10) & Chr(10) & "Cliquer sur OK pour quitter Excel." 'sans raison ici

     NomFic = Dir 'on recherche le fichier DataExtraction suivant

Wend

'msgbox après boucle éventuellement

End Sub

Cordialement,

Le 09/09/2020 à 06:56

Merci. Le but n'est pas de traiter plusieurs fichiers simultanément, mais de faire en sorte que la macro fonctionne, même si le fichier ouvert s'appelle "DataExtraction(1).csv".

Le 09/09/2020 à 10:25

Bonjour,

Mince alors, tous ces efforts pour rien. En essayant comme ça, ça pourrait le faire (pour n'importe quel fichier d'ailleurs) :

Sub Import()

Dim WbExport as workbook, WbExtrac as workbook
Dim NomFic$

Set WbExport = workbooks("ExportData.xlsm") 'classeur servant à l'export

NomFic = Application.GetOpenFilename(, , "Importation des données")
'NomFic = Application.GetOpenFilename("DataExtraction Files (DataExtraction*.csv), DataExtraction*.csv", "Importation des données") 'a essayer

If NomFic <> False Then
    Workbooks.OpenText Filename:=NomFic, DataType:=1, Semicolon:=True, local:=True 'ouverture fichier DataExtraction
End if

Set WbExtrac = ActiveWorkbook 'Affectation du classeur DataExtraction

'WbExport.Sheets("donnees").Range("A2:G500").clearcontents '??? effacer au préalable les contenus ? (quid ranges tailles différentes)
'WbExport.Sheets("Contacts").cells.clearcontents '??? effacer au préalable les contenus ?

With WbExtrac
    .Range("C2:D140,I2:I140,N2:P140").Copy destination:=WbExport.Sheets("donnees").Range("B2") 'copier/coller en B2 de données
    .Close savechanges:=true 'fermeture
end with

With WbExport
    .Sheets("donnees").Range("$A$1:$G$194").AutoFilter Field:=1, Criteria1:="<>" 'Filtrer (? pourquoi A1:G194 ?)
    .Sheets("donnees").Range("A1:G500").Copy 'copier
    .Sheets("Contacts").Range("A1").PasteSpecial Paste:=xlPasteValues 'coller valeurs dans contacts
    .SaveAs Filename:="ExportFinal_" & format(Now, "YYMMDD-HHMMSS") & ".csv", FileFormat:=xlCSV, CreateBackup:=False 'sauvegarde sous nv csv "ExportFinal avec Horodatage" pour éviter bug ou écrasement du fichier précédent
end with

MsgBox "Le fichier ExportFinal.csv a été enregistré au même endroit que le fichier ExportData.xlsm qui vous a permis de le créer." _
& Chr(10) & Chr(10) & "Cliquer sur OK pour quitter Excel."

Set WbExtract = Nothing
Set WbExport = Nothing

End Sub

Cordialement,

Rechercher des sujets similaires à "ajouter tout caractere nom fichier"