FileToOpen -> garder en memoire fichier deja ouvert

floon

XLDnaute Nouveau
Bonjour a tous,

Apres vous avoir deja embetez pour mes comparaisons d'erreurs, demander de l'aide pour la creation d'une progressbar ( j'en ai 2 maintenant qui tourne niquel :D ) je recidive avec un nouveau probleme :

J'ouvre enormement de fichiers de logs avec ma macro a travers la fonction FiletoOpen, mais n'etant pas le seul utilisateur du fichier il faudrait que je trouve un moyen de pas ouvrir 2 fois le meme fichier ... ( le temps de traitement d'un fichier est assez long et ca fausserai les resultats )

Precedement on m'a indique que FileToOpen se servait d'un tableau que l'on pouvait voir grace a ca :
Range("a1").Resize(UBound(filetoopen), 1) = Application.Transpose(filetoopen)

Cela donne des lignes du genre :
E:\temp\logs\SEMCD8_May08
E:\temp\logs\SEMCD8_May15
E:\temp\logs\SEMCD7_May08
E:\temp\logs\SEMCD7_May15

J'aimerai savoir si il est possible de stocker ces fichiers dans un tableau puis de comparer ce tableaux avec la prochaine ouverture de fichiers
si j'ouvre plusieurs fichiers :
E:\temp\logs\SEMCD8_May22
E:\temp\logs\SEMCD8_May29
E:\temp\logs\SEMCD8_May08
E:\temp\logs\SEMCD7_May08
E:\temp\logs\SEMCD7_May15
il ne faut pas que les fichiers deja ouvert soit re-ouvert, il faudrait que l'on obtienne :
E:\temp\logs\SEMCD8_May22
E:\temp\logs\SEMCD8_May29

Il faudrait aussi que le chemin ( l'emplacement des logs ) n'est pas d'importance, en gros recuperer que le nom interessant
SEMCD8_May22
SEMCD8_May29

Une fois que j'ai obtenu la liste des fichiers a ouvrir il faut que je les relance dans ma boucle d'origine
Code:
'ouverture fichiers
filetoOpen = Application.GetOpenFilename(, , , , True)
'If filetoOpen <> False Then GoTo 300
NbFileOpen = UBound(filetoOpen) 'nombre de fichiers a ouvrir pour progressbar
Application.ScreenUpdating = False
For Each Item In filetoOpen
'suite traitement
J'ai bien essayer de faire cela mais euh je bloque n'ayant pas tout compris sur les tri de doublons par tableaux ( j'ai du mal avec les tableaux ).
Je sais pas si cela est possible mais ca me debloquerait bien, sinon il faudra ouvrir tous les fichiers et faire une recherche de doublon sur l'integralite des donnnees ( faisable mais moins bien :eek: )

Merci d'avance pour votre science ;)
 

Hervé

XLDnaute Barbatruc
Re : FileToOpen -> garder en memoire fichier deja ouvert

bonjour floon

Bon, comme tu n'a pas eu de réponse, je me lance à travers la piece jointe.

ce code récupere les fichiers sélectionnés par getopenfilename, extrait les noms des fichiers, vérifie que ceux ci ne sont pas déjà présent dans la colonne A de la feuille et remplace cette liste.

En espérant que ceci te sera utile.

salut
 

Pièces jointes

  • Classeur2.zip
    9 KB · Affichages: 44
  • Classeur2.zip
    9 KB · Affichages: 44
  • Classeur2.zip
    9 KB · Affichages: 41

floon

XLDnaute Nouveau
Re : FileToOpen -> garder en memoire fichier deja ouvert

Salut tout le monde,
Salut Hervé,

Merci pour ton travail, le principe est bon, par contre j'arrive pas a l'integrer dans ma macro :
( En faite je me suis mal exprimer dans mon enonce ) je sais pas comment reutiliser ton tableaux derriere pour que le traitement s'effectue sur chaque fichier a ouvrir :
j'avais ca avant :
Code:
sub ouvrir()
'ouverture fichiers
filetoopen = Application.GetOpenFilename(, , , , True)
For Each Item In filetoopen
'traitement fichiers
' Workbooks.OpenText Filename:= _
'        Item, Origin _
'        :=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
'        xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
'        Comma:=True, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
'        Array(2, 2), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
'        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), TrailingMinusNumbers:=True
'suite traitement
'traitement encore tres long ... 
Next Item
End Sub
et maintenant :
Code:
'ouverture fichiers
filetoopen = Application.GetOpenFilename(, , , , True)
'If filetoOpen <> False Then GoTo 300
NbFileOpen = UBound(filetoopen)
Application.ScreenUpdating = False
'memorisation fichier deja ouvert
If Range("r1") = "" Then
    Range("r1").Resize(UBound(filetoopen), 1) = Application.Transpose(extractionnom(filetoopen))
Else
    tablo = Range("r1:r" & Range("r65536").End(xlUp).Row)
    filetoopen = extractionnom(filetoopen)
    On Error Resume Next
    For i = 1 To UBound(filetoopen)
        data.Add filetoopen(i), CStr(filetoopen(i))
    Next i
    For i = 1 To UBound(tablo)
        data.Add tablo(i, 1), CStr(tablo(i, 1))
    Next i
    On Error GoTo 0
    
    ReDim tablo(1 To data.Count, 1 To 1)
    For i = 1 To data.Count
        tablo(i, 1) = data(i)
    Next i
    Range("r1").Resize(UBound(tablo), 1) = tablo
End If
'For Each Item In filetoopen
traitement fichiers
 Workbooks.OpenText Filename:= _
        Item, Origin _
        :=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
        Comma:=True, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 2), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), TrailingMinusNumbers:=True
'suite traitement
'traitement encore tres long ... 
'Next Item
End Sub
l'autre fonction est integre juste apres (Public Function extractionnom(tabnom As Variant))
Mais la ca coince a l'ouverture proprement dite du fichier log

Merci pour ton aide :eek:
 
Dernière édition:

Hervé

XLDnaute Barbatruc
Re : FileToOpen -> garder en memoire fichier deja ouvert

re

il te suffit de boucler sur les fichiers de la colonne A

PHP:
'....
For Each c In Range("a1:a" & Range("a65536").End(xlUp).Row)
'traitement fichiers
 Workbooks.OpenText Filename:= _
        c, Origin _
        :=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
        Comma:=True, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 2), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), TrailingMinusNumbers:=True
'suite traitement
'traitement encore tres long ...
Next c

salut
 

floon

XLDnaute Nouveau
Re : FileToOpen -> garder en memoire fichier deja ouvert

Merci herve ca marche niquel !
Y a juste encore un detail :eek: j'ai une progrssbar avec le nombremax defini par le nombre de fichier a ouvrir
Code:
NbFileOpen = UBound(filetoopen)

Dans ce cas si je peux faire :
Code:
NbFileOpen = UBound(tablo)
:confused:
 

floon

XLDnaute Nouveau
Re : FileToOpen -> garder en memoire fichier deja ouvert

Salut tout le monde, le forum, le fil et Hervé
Hervé à dit:
bonjour floon, le forum

ton nombre de fichier sera le nombre de ligne occupée en colonne A :

NbFileOpen =Range("a65536").End(xlUp).Row

salut
Ca va fausser ma barre tout ca : si je prend en compte le nombre de fichier present dans la colonne A j'aurais tous les fichiers deja ouvert et non ceux a ouvrir ?
Ou alors j'ai pas tout compris ... ce aqui n'est pas impossible bien au ocntraire :eek:
 

floon

XLDnaute Nouveau
Re : FileToOpen -> garder en memoire fichier deja ouvert

bonjour tout le monde,

je remet a jour ce post parce que j'ai des problemes d'ouverture de mes fichiers : si je selectionne un fichier deja ouvert, il l'ouvre quand meme !
Etant donne que j'ouvre a l'heure actuelle 190 fichiers et que ca grossi de 13 fichiers par semaine, le temps de traitement commence a etre long ...
Code:
'ouverture fichiers
filetoopen = Application.GetOpenFilename(, , , , True)
Application.ScreenUpdating = False
'memorisation fichier deja ouvert
If Range("aj1") = "" Then
    Range("aj1").Resize(UBound(filetoopen), 1) = Application.Transpose(extractionnom(filetoopen))
Else
    tablo = Range("aj1:aj" & Range("aj65536").End(xlUp).Row)
    filetoopen = extractionnom(filetoopen)
    On Error Resume Next
    For i = 1 To UBound(filetoopen)
        data.Add filetoopen(i), CStr(filetoopen(i))
    Next i
    For i = 1 To UBound(tablo)
        data.Add tablo(i, 1), CStr(tablo(i, 1))
    Next i
    On Error GoTo 0
    
    ReDim tablo(1 To data.Count, 1 To 1)
    For i = 1 To data.Count
        tablo(i, 1) = data(i)
    Next i
    Range("aj1").Resize(UBound(tablo), 1) = tablo
End If
'traitement fichiers
NbFileOpen = Range("aj65536").End(xlUp).Row
For Each C In Range("aj1:aj" & Range("aj65536").End(xlUp).Row)
 Workbooks.OpenText Filename:= _
        C, Origin _
        :=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
        Comma:=True, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 2), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), TrailingMinusNumbers:=True

J'ai du me melanger les pinceaux a un moment parce que ca marcher bien puis plus rien
les fichiers sont bien ajoutés dans la colonne "aj" mais la macro quand meme tous les fichiers derriere.
 

Discussions similaires

Statistiques des forums

Discussions
312 492
Messages
2 088 902
Membres
103 982
dernier inscrit
krakencolas