Rcherche fichier dans dossier VBA
bonjour,
je voudrai suivre un chemin qui n'est rien d'autre que clui là:
Chemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO suivi quotidien\Résultat économique"
le problème est que le dossier "Résultat économique" contient plusieurs fichiers de noms differents
mais moi ceux qui m'interressent ce sont ceux nommés par exemple :20100701-résultat economique ,20100701 c'est en fait la date d'hier c'est donc le fichier le plus recent de nom:"20100701-résultat economique "
un nouveau fichier est completé chaque jour de date égale a la date du jour -1 .
mois je voudrai donc allez dans ce dernier fichier et copier la derniere ligne non vide de l'onglet ("Historik") puis mettre cette ligne a la derniere ligne vide de mon classeur "varpara" a la feuille "feuil1"
j'ai donc fait comme ci-dessous mais ça ne marche pas si quelqu'un veut bien me'aider pour que le code aille tout simplement dans le fichier le plus recent de nom du type "20100701-résultat economique " sachant qu'il y a d'autres fichiers dans le dossier ,
tous les fichiers du dossier commence par la date comme indiqué plus haut
voici mon code:
Function NomPlusJeuneFichier(Chemin As String) As String
Dim Fso As FileSystemObject
Dim Fichier As File
Dim plus_Jeune_fichier As File
Dim LaDate As Date, DatePlusJeuneFichier As Date
For Each Fichier In Fso.GetFolder(Chemin).Files
If plus_Jeune_fichier Is Nothing Then
Set plus_Jeune_fichier = Fichier
DatePlusJeuneFichier = CDate(Left(Fichier.Name, InStr(1, Fichier.Name, " Résultat Economique ") - 1))
Else
LaDate = CDate(Left(Fichier.Name, InStr(1, Fichier.Name, " Résultat Economique ") - 1))
If LaDate > DatePlusJeuneFichier Then
DatePlusJeuneFichier = LaDate
Set plus_Jeune_fichier = Fichier
End If
End If
Next
' // Résultat
If plus_Jeune_fichier Is Nothing Then
NomPlusJeuneFichier = ""
Else
NomPlusJeuneFichier = plus_Jeune_fichier.Name
End If
End Function
Sub recherche_historik()
Dim Chemin As String
Chemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO suivi quotidien\Résultat économique"
MsgBox "Le fichier le plus récent de nom résultat économique du répertoire S:\ est : " & NomPlusJeuneFichier(Chemin)
End Submerci de votre aide
Re-,
Tu aurais pu :
- Répondre à ma dernière intervention avant de poser une nouvelle question
- Rester sur le même fil
https://forum.excel-pratique.com/excel/copier-d-un-classuer-vers-un-autre-t17855.html
Regarde cette solution :
Function NomPlusJeuneFichier(Chemin As String) As String
Dim Fso As FileSystemObject
Dim Fichier As File
Dim plus_Jeune_fichier As File
Dim LaDate As Date, DatePlusJeuneFichier As Date
Dim X As String
Set Fso = CreateObject("scripting.filesystemobject")
For Each Fichier In Fso.GetFolder(Chemin).Files
X = Val(Left(Fichier.Name, InStr(1, Fichier.Name, "-") - 1))
If plus_Jeune_fichier Is Nothing Then
Set plus_Jeune_fichier = Fichier
DatePlusJeuneFichier = CDate(Left(X, 4) & "/" & Mid(X, 5, 2) & "/" & Right(X, 2))
Else
LaDate = CDate(Left(X, 4) & "/" & Mid(X, 5, 2) & "/" & Right(X, 2))
If LaDate > DatePlusJeuneFichier Then
DatePlusJeuneFichier = LaDate
Set plus_Jeune_fichier = Fichier
End If
End If
Next
' // Résultat
If plus_Jeune_fichier Is Nothing Then
NomPlusJeuneFichier = ""
Else
NomPlusJeuneFichier = plus_Jeune_fichier.Path
End If
End FunctionApprend un peu les règles des forums (notamment, d'éviter les multipostages, sur des forums différents....)
j'ai bien enregistré tes remarques cousinhub ,desolé.
Tu aurais pu :
- Répondre à ma dernière intervention avant de poser une nouvelle question
- Rester sur le même fil
voila je crois que j'ai une modification a faire ici:
Sub recherche_historik()
Dim LeChemin As String, LaFeuille As String, LeFichier As String
Dim LaCellule
Dim Tblo
LeChemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO suivi quotidien\Résultat économique"
LeFichier = NomPlusJeuneFichier(LeChemin)
LaFeuille = "Historik"
For Each LaCellule In Tblo
With Sheets("Feuil1").[G65000].End(xlUp)(2)
.FormulaArray = "='" & LeChemin & "\[" & LeFichier & "]" & LaFeuille & "'!" & LaCellule
.Value = .Value
End With
Next LaCellule
End Subcomment je peux faire pour copier la deniere ligne non vide de la feuille "historik" du classeur suivant le chemin indiqué??
-ensuite la coller dans feuil1 de mon classeur a la premiere ligne vide
merci d'avance
Re-,
Bon, ça n'a pas été simple....(pas mal de recherches, et d'adaptations....)
ci-dessous, un code et 2 fonctions
Attention, on va utiliser la technique ADO pour lire un fichier fermé
Pour cela, il faut que tu valides "Microsoft ActiveX Data Objects 6.x Library" dans "Outils/Références" sous l'éditeur VBE
le code :
Dans ce code, j'ai mis une zone empirique "A1:H2000"
S'il y a plus de colonnes, ou de lignes, met à peu près la zone qui est remplie dans le classeur "20100701.......xls"
Seules les cellules remplies seront prises en compte, donc n'aies pas peur...
Sub recherche_historik()
Dim LeChemin As String, LaFeuille As String, LeFichier As String
Dim Tblo
Dim tb()
Dim Zone As String
LeChemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO suivi quotidien\Résultat économique"
LeFichier = NomPlusJeuneFichier(LeChemin)
LaFeuille = "Historik"
Zone = "A1:H2000"
ObtenirDonnees LeFichier, LaFeuille, Zone, False, Tblo
Set LeRange = Range(Zone)
NbCol = LeRange.Columns.Count
For i = 1 To NbCol
ReDim Preserve tb(0 To i - 1)
tb(i - 1) = Tblo(UBound(Tblo), i)
Next i
[A65000].End(xlUp)(2).Resize(1, NbCol).Value = tb
End SubLa première fonction, c'est celle que je t'ai déjà donné, pour chercher le fichier le plus récent
la deuxième fonction :
Public NbCol As Byte
Sub ObtenirDonnees(Fich As String, _
Feuille As String, _
Zone As String, _
Titre As Boolean, _
Tablo2 As Variant)
'd'après Héctor Miguel, mpep
Dim myConn As ADODB.Connection, myCmd As ADODB.Command
Dim HDR As String, myRS As ADODB.Recordset, RS_n As Integer, RS_f As Integer
Dim Tblo
Dim LeRange As Range
Dim NbCol As Byte
Set myConn = New ADODB.Connection
If Titre = True Then HDR = "Yes" Else HDR = "No"
myConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fich & ";" & _
"Extended Properties=""Excel 8.0;" & _
"HDR=" & HDR & ";IMEX=1;"""
Set myCmd = New ADODB.Command
myCmd.ActiveConnection = myConn
If Feuille = "" _
Then myCmd.CommandText = "SELECT * from `" & Zone & "`" _
Else myCmd.CommandText = "SELECT * from `" & Feuille & "$" & Zone & "`"
Set myRS = New ADODB.Recordset
myRS.Open myCmd, , adOpenKeyset, adLockOptimistic
ReDim Tblo(1 To myRS.RecordCount, 1 To myRS.Fields.Count)
myRS.MoveFirst
Do While Not myRS.EOF
For RS_n = 1 To myRS.RecordCount 'lignes
For RS_f = 0 To myRS.Fields.Count - 1 'colonnes
Tblo(RS_n, RS_f + 1) = myRS.Fields(RS_f).Value
Next
myRS.MoveNext
Next
Loop
myConn.Close
Set myRS = Nothing
Set myCmd = Nothing
Set myConn = Nothing
Tablo2 = Tblo
End SubOn recopie la dernière ligne du fichier fermé dans la première ligne vide de ton classeur
Ouf.....
voila j'ai regardé ,mais jai quelques interrogations vu que je n'ai pas encore tout compri du code que tu m'a envoyé
-pourquoi la fonction que tu viens de faire a un sub et un end sub??
*** comment je dispose mes fonctions par rapport a recherche_historik()........??
**quand tu me dis d'adapter
Fichier = "C:\Users\bibi\Documents\Excel\essai date\20100629-Résultat économique.xls" 'à adapterj'ai pensé a le faire comme ceci:
"S:\PGB\DER\_Commun\MBO\RESULTAT ECO suivi quotidien\Résultat économique"sauf que dans ton exemple: Fichier =
"C:\Users\bibi\Documents\Excel\essai date\20100629-Résultat économique.xls" 'à adapter
tu ajoute le fichier le plus recent mais comment je vais l'indiquer a chaque fois le fichier le plus recent ?
merci de m'expliquer ces points .
re-,
une erreur de ma part, j'ai rectifié dans mon post précédent...
Il faut lancer "recherche_historik"
Scuse
voici comment j'ai disposé le code
Public NbCol As Byte
Sub LitFichierFermé()
Dim Fichier$, Tblo
Dim tb()
Dim Zone As String
Zone = "A1:G2000"
Fichier = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO suivi quotidien\Résultat économique\20100701 - Résultat Economique "
ObtenirDonnees Fichier, "Feuil1", Zone, False, Tblo
Set LeRange = Range(Zone)
NbCol = LeRange.Columns.Count
For i = 1 To NbCol
ReDim Preserve tb(0 To i - 1)
tb(i - 1) = Tblo(UBound(Tblo), i)
Next i
[A65000].End(xlUp)(2).Resize(1, NbCol).Value = tb
End Sub
Function NomPlusJeuneFichier(Chemin As String) As String
Dim Fso As FileSystemObject
Dim Fichier As File
Dim plus_Jeune_fichier As File
Dim LaDate As Date, DatePlusJeuneFichier As Date
Dim X As String
Set Fso = CreateObject("scripting.filesystemobject")
For Each Fichier In Fso.GetFolder(Chemin).Files
X = Val(Left(Fichier.Name, InStr(1, Fichier.Name, " ") - 1))
If plus_Jeune_fichier Is Nothing Then
Set plus_Jeune_fichier = Fichier
DatePlusJeuneFichier = CDate(Left(X, 4) & "/" & Mid(X, 5, 2) & "/" & Right(X, 2))
Else
LaDate = CDate(Left(X, 4) & "/" & Mid(X, 5, 2) & "/" & Right(X, 2))
If LaDate > DatePlusJeuneFichier Then
DatePlusJeuneFichier = LaDate
Set plus_Jeune_fichier = Fichier
End If
End If
Next
' // Résultat
If plus_Jeune_fichier Is Nothing Then
NomPlusJeuneFichier = ""
Else
NomPlusJeuneFichier = plus_Jeune_fichier.Path
End If
End Function
Sub ObtenirDonnees(Fich As String, _
Feuille As String, _
Zone As String, _
Titre As Boolean, _
Tablo2 As Variant)
'd'après Héctor Miguel, mpep
Dim myConn As ADODB.Connection, myCmd As ADODB.Command
Dim HDR As String, myRS As ADODB.Recordset, RS_n As Integer, RS_f As Integer
Dim Tblo
Dim LeRange As Range
Dim NbCol As Byte
Set myConn = New ADODB.Connection
If Titre = True Then HDR = "Yes" Else HDR = "No"
myConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fich & ";" & _
"Extended Properties=""Excel 8.0;" & _
"HDR=" & HDR & ";IMEX=1;"""
Set myCmd = New ADODB.Command
myCmd.ActiveConnection = myConn
If Feuille = "" _
Then myCmd.CommandText = "SELECT * from `" & Zone & "`" _
Else myCmd.CommandText = "SELECT * from `" & Feuille & "$" & Zone & "`"
Set myRS = New ADODB.Recordset
myRS.Open myCmd, , adOpenKeyset, adLockOptimistic
ReDim Tblo(1 To myRS.RecordCount, 1 To myRS.Fields.Count)
myRS.MoveFirst
Do While Not myRS.EOF
For RS_n = 1 To myRS.RecordCount 'lignes
For RS_f = 0 To myRS.Fields.Count - 1 'colonnes
Tblo(RS_n, RS_f + 1) = myRS.Fields(RS_f).Value
Next
myRS.MoveNext
Next
Loop
myConn.Close
Set myRS = Nothing
Set myCmd = Nothing
Set myConn = Nothing
Tablo2 = Tblo
End Sub
Sub recherche_historik()
Dim LeChemin As String, LaFeuille As String, LeFichier As String
Dim Tblo
Dim tb()
Dim Zone As String
LeChemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO suivi quotidien\Résultat économique"
LeFichier = NomPlusJeuneFichier(LeChemin)
LaFeuille = "Historik"
Zone = "A1:AB2000"
ObtenirDonnees LeFichier, LaFeuille, Zone, False, Tblo
Set LeRange = Range(Zone)
NbCol = LeRange.Columns.Count
For i = 1 To NbCol
ReDim Preserve tb(0 To i - 1)
tb(i - 1) = Tblo(UBound(Tblo), i)
Next i
[A65000].End(xlUp)(2).Resize(1, NbCol).Value = tb
End Sub
mais il m'indique une erreur a cette ligne :
X = Val(Left(Fichier.Name, InStr(1, Fichier.Name, " ") - 1))""argument ou appel de procedure incorrect""
Re-,
J'ai comme l'impression que tu ne lis pas tout....
J'ai rectifié le code, ce n'est pas "LitFichierFermé" qu'il faut lancer, mais "recherche_historik"
Et ensuite, je ne vois pas du tout cette ligne, dans la fonction "NomPlusJeuneFichier"
X = Val(Left(Fichier.Name, InStr(1, Fichier.Name, " ") - 1))mais cette ligne-là :
X = Val(Left(Fichier.Name, InStr(1, Fichier.Name, "-") - 1))il me semble que tu as un tiret, après la "date" : 20100701-......
recopie bien les fonctions, puis le code
j'ai bien un tiret apres la date comme tu l'a remarqué
MAIS le code ne tourne pas toujours la meme erreur !
je te renvoie le code pour que tu vois comment je l'ai sur mon pc:
Public NbCol As Byte
Sub LitFichierFermé()
Dim Fichier$, Tblo
Dim tb()
Dim Zone As String
Zone = "A1:AB2000"
Fichier = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO suivi quotidien\Résultat économique\20100701 - Résultat Economique "
ObtenirDonnees Fichier, "Feuil1", Zone, False, Tblo
Set LeRange = Range(Zone)
NbCol = LeRange.Columns.Count
For i = 1 To NbCol
ReDim Preserve tb(0 To i - 1)
tb(i - 1) = Tblo(UBound(Tblo), i)
Next i
[A65000].End(xlUp)(2).Resize(1, NbCol).Value = tb
End subFunction NomPlusJeuneFichier(Chemin As String) As String
Dim Fso As FileSystemObject
Dim Fichier As File
Dim plus_Jeune_fichier As File
Dim LaDate As Date, DatePlusJeuneFichier As Date
Dim X As String
Set Fso = CreateObject("scripting.filesystemobject")
For Each Fichier In Fso.GetFolder(Chemin).Files
X = Val(Left(Fichier.Name, InStr(1, Fichier.Name, "-") - 1))
If plus_Jeune_fichier Is Nothing Then
Set plus_Jeune_fichier = Fichier
DatePlusJeuneFichier = CDate(Left(X, 4) & "/" & Mid(X, 5, 2) & "/" & Right(X, 2))
Else
LaDate = CDate(Left(X, 4) & "/" & Mid(X, 5, 2) & "/" & Right(X, 2))
If LaDate > DatePlusJeuneFichier Then
DatePlusJeuneFichier = LaDate
Set plus_Jeune_fichier = Fichier
End If
End If
Next
' // Résultat
If plus_Jeune_fichier Is Nothing Then
NomPlusJeuneFichier = ""
Else
NomPlusJeuneFichier = plus_Jeune_fichier.Path
End If
End FunctionSub ObtenirDonnees(Fich As String, _
Feuille As String, _
Zone As String, _
Titre As Boolean, _
Tablo2 As Variant)
'd'après Héctor Miguel, mpep
Dim myConn As ADODB.Connection, myCmd As ADODB.Command
Dim HDR As String, myRS As ADODB.Recordset, RS_n As Integer, RS_f As Integer
Dim Tblo
Dim LeRange As Range
Dim NbCol As Byte
Set myConn = New ADODB.Connection
If Titre = True Then HDR = "Yes" Else HDR = "No"
myConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fich & ";" & _
"Extended Properties=""Excel 8.0;" & _
"HDR=" & HDR & ";IMEX=1;"""
Set myCmd = New ADODB.Command
myCmd.ActiveConnection = myConn
If Feuille = "" _
Then myCmd.CommandText = "SELECT * from `" & Zone & "`" _
Else myCmd.CommandText = "SELECT * from `" & Feuille & "$" & Zone & "`"
Set myRS = New ADODB.Recordset
myRS.Open myCmd, , adOpenKeyset, adLockOptimistic
ReDim Tblo(1 To myRS.RecordCount, 1 To myRS.Fields.Count)
myRS.MoveFirst
Do While Not myRS.EOF
For RS_n = 1 To myRS.RecordCount 'lignes
For RS_f = 0 To myRS.Fields.Count - 1 'colonnes
Tblo(RS_n, RS_f + 1) = myRS.Fields(RS_f).Value
Next
myRS.MoveNext
Next
Loop
myConn.Close
Set myRS = Nothing
Set myCmd = Nothing
Set myConn = Nothing
Tablo2 = Tblo
End Sub
Sub recherche_historik()
Dim LeChemin As String, LaFeuille As String, LeFichier As String
Dim Tblo
Dim tb()
Dim Zone As String
LeChemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO suivi quotidien\Résultat économique"
LeFichier = NomPlusJeuneFichier(LeChemin)
LaFeuille = "Historik"
Zone = "A1:AB2000"
ObtenirDonnees LeFichier, LaFeuille, Zone, False, Tblo
Set LeRange = Range(Zone)
NbCol = LeRange.Columns.Count
For i = 1 To NbCol
ReDim Preserve tb(0 To i - 1)
tb(i - 1) = Tblo(UBound(Tblo), i)
Next i
[A65000].End(xlUp)(2).Resize(1, NbCol).Value = tb
End Sub
voilà c'est ainsi que je l'ai puis j'ai lancé "recherche_historik" resultat des courses :"argument ou appel de procedure incorrect"
merci de m'aider encore
Bonjour,
regarde dans le fichier joint, j'ai mis les trois codes...
Il y a trois modules, un module "C_Recherche", qui contient le code à lancer, un module "F_NomFichier", qui contient la fonction pour rechercher le dernier fichier, et un module "F_Import", qui contient la fonction pour importer la dernière ligne...
Les variables "Chemin" (chemin du répertoire à scanner), "LaFeuille" qui comporte le nom de l'onglet, et "Zone" qui comporte la zone à rapatrier doivent être mis dans le module "C_Recherche"
Chez moi, cela fonctionne...
bon courage
BONJOUR TOUT LE MONDE ,BONJOUR cousinhub
desolé de te perdre du temps mais j'ai ps compris ce que tu essai de me dire ici:
- Les variables "Chemin" (chemin du répertoire à scanner), "LaFeuille" qui comporte le nom de l'onglet, et "Zone" qui comporte la zone à rapatrier doivent être mis dans le module "C_Recherche"
et quand je lance le code j'ai une erreur "argument ou appel de procedure incorrect"
ensuite j'ai appuyé sur debeugage et il m'indique que l'erreur se trouve ici:
X = Val(Left(Fichier.Name, InStr(1, Fichier.Name, "-") - 1))merci de votre patience .
Bonjour,
Tout d'abord, tu confirmes que tes fichiers se nomment bien : "20100703-blablabla...."?
sans espace après le tiret...
Et que tu n'as que des fichiers commençant ainsi dans ce répertoire?
Sinon, il va falloir faire un test sur les noms de fichiers, ou mieux, déplace tous les fichiers qui ne commencent pas ainsi dans un autre répertoire, ou sous-répertoire
Et ensuite, dans le module C_Recherche, tu as ces lignes :
LeChemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO suivi quotidien\Résultat économique"
LeFichier = NomPlusJeuneFichier(LeChemin)
LaFeuille = "Historik"
Zone = "A1:H2000"Est-ce que tu as bien défini ces variables (LeChemin, LaFeuille, Zone)?
OUI MES FICHIERS SE NOMMENT BIEN 20100705 - résutat economique
il y a un espace avant et apres le tiret .
** oui j'ai bien defini les variables dans le module "C_Recherche"
par contre je n'ai pas le droit que creer in sous repertoire pour regrouper l'ensemble des fichiers qui m'interressent.
Bonjour,
Je ne sais pas si tu fréquentes depuis longtemps des forums d'entraide, mais en langage "Forumistique", écrire en MAJUSCULE signifie "Crier"...
Nous ne sommes pas sur Facebook ou autre MSN....
Si cela te dérange que je te pose des questions "bêtes", ou que cela te gonfle, n'hésite surtout pas à me le dire...
Car, comme je te le rappelle :
Chez moi, cela fonctionne...
Il est vrai, également, que dans le répertoire que je teste, il n'y a que des fichiers commençant ainsi :
"2010......."
Remarque, dans le premier fil que tu avais ouvert, ils se nommaient "2010-6-21.....", dans le premier post de ce fil, ils se nomment "20100701-résultat economique" (sans espace...).
Peut-être qu'un jour, tu donneras la bonne version.
Tu vois, cela fait un moment que je fréquente ce genre de forum, et il est très rare que je m'emporte...
En attendant, je te propose de changer la fonction "NomPlusJeuneFichier" dans le module F_Nom_Fichier par cette fonction :
Function NomPlusJeuneFichier(Chemin As String) As String
Dim Fso As FileSystemObject
Dim Fichier As file
Dim plus_Jeune_fichier As file
Dim LaDate As Date, DatePlusJeuneFichier As Date
Dim X As String
Set Fso = CreateObject("scripting.filesystemobject")
For Each Fichier In Fso.GetFolder(Chemin).Files
If Left(Fichier.Name, 3) = "201" Then
X = Val(Left(Fichier.Name, InStr(1, Fichier.Name, "-") - 1))
If plus_Jeune_fichier Is Nothing Then
Set plus_Jeune_fichier = Fichier
DatePlusJeuneFichier = CDate(Left(X, 4) & "/" & Mid(X, 5, 2) & "/" & Right(X, 2))
Else
LaDate = CDate(Left(X, 4) & "/" & Mid(X, 5, 2) & "/" & Right(X, 2))
If LaDate > DatePlusJeuneFichier Then
DatePlusJeuneFichier = LaDate
Set plus_Jeune_fichier = Fichier
End If
End If
End If
Next
' // Résultat
If plus_Jeune_fichier Is Nothing Then
NomPlusJeuneFichier = ""
Else
NomPlusJeuneFichier = plus_Jeune_fichier.path
End If
End FunctionEn espérant que cela fonctionne...
Sans rancune
'bonjour tout le monde ,bonjour cousinhub
'ça fait pas longtemps que je frequente les forums bien que se ne soit pas vraiment une excuse valable
'je ne savais pas qu'écrire en majuscule signifiait crier et j'en suis desolé et je ne suis ni
'débordé ni emporté bien que je soit embeté par cet exercice bref..
la bonne version c'est celle là 20100705 - Résulta Economique il y a un espace avant et apres le tiret
'pour moi toutes les questions ont un sens ,pas hésiter pour me les poser .
'voila j'ai remplacé la fonction ,puis j'ai lacé le module "C_Recherche" mais ça ne fonctionnne
'pas j'ai une erreur du type "le moteur de base de données Microsoft jet n'a pas pu trouver l'objet Historik $A1:AB2000
'puis j'ai fait un debogage et il m'indique que l'erreur se trouve dans le module F_import
'a cette ligne:
myRS.Open myCmd, , adOpenKeyset, adLockOptimisticmerci beaucop de ton aide .
Re-,
J'ai la même erreur si le nom de l'onglet n'est pas "Exactement" "Historik"
Attention aux espaces, devant ou derrière le nom de l'onglet....
-- Mar Juil 06, 2010 8:04 pm --
Edit,
Je me suis aperçu d'une erreur, si jamais on a vu trop grand, avec le nombre de colonnes (dans ton exemple, tu prends jusqu'à la colonne AB), il va y avoir une erreur...
change le code "Sub recherche_historik()" dans le module C_Recherche par celui-ci :
Public Tblo
Sub recherche_historik()
Dim LeChemin As String, LaFeuille As String, LeFichier As String
Dim Tb()
Dim I As Byte
Dim Zone As String
LeChemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO suivi quotidien\Résultat économique"
LeFichier = NomPlusJeuneFichier(LeChemin)
LaFeuille = "Historik"
Zone = "A1:AB20000"
ObtenirDonnees LeFichier, LaFeuille, Zone, False, Tblo
On Error Resume Next
Do
I = I + 1
ReDim Preserve Tb(0 To I - 1)
Tb(I - 1) = Tblo(UBound(Tblo), I)
Loop Until Err
[A65000].End(xlUp)(2).Resize(1, I).Value = Tb
Tblo = ""
End SubNormalement, c'est bon....
j'ai toujours la meme erreur
j'ai verifier les espaces et les noms a l'aide de l'enregistreur de macro ,puis le chemin d'acces tout est correct a ce niveau .
peu etre que l'execution n'envoie pas faire une fouille dans le classeur le plus recent du type (20100705 - Résulta Economique)
je tiens a preciser que tous les types de fichiers sont misa jours chaque jour donc faire une recherche seulement sur la date la plus recente c'est pas complet (peu etre que le type de fichier dans lequel je fais ma recherche a eté mis a jour avant tous les autres donc la recherche sur la date la plus recente ne fonctionnerra pas a mon avis)
il faut aussi je pense spécifier le type de fichier dont il s'agit ,enfin peu etre que cela existe deja dans le code ...
si tu permets histoire de mieux te faire par de mes idées :
que penses tu d'une fonction de ce genre que tu peu adapter bien sur par rapport ce que tu as fais
Function NomPlusJeuneFichierByName(Chemin As String, PatternNomFichier As String) As String
Dim Fso As FileSystemObject
Dim Fichier As File
Dim PlusJeuneFichier As File
Set Fso = CreateObject("scripting.filesystemobject")
For Each Fichier In Fso.GetFolder(Chemin).Files
If Fichier.Name Like PatternNomFichier _
Then
If PlusJeuneFichier Is Nothing Then
Set PlusJeuneFichier = Fichier
ElseIf Fichier.Name > PlusJeuneFichier.Name Then
Set PlusJeuneFichier = Fichier
End If
End If
Next
' // Résultat
If PlusJeuneFichier Is Nothing Then
NomPlusJeuneFichierByName = ""
Else
NomPlusJeuneFichierByName = PlusJeuneFichier.Path
End If
End FunctionSub toto_22()
Dim I As Long
Dim k As Long
Dim Chemin As String, LaFeuille As String, LeFichier As String
Dim motif As String
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks("Classeurvarparahist")
Set ws = wb.Worksheets("Feuil1")
k = ws.Cells(Rows.Count, 4).End(xlUp).Row + 1
LaFeuille = "Historik"
motif = "######## - Résultat Economique"
Chemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO suivi quotidien\Résultat économique"
LeFichier = NomPlusJeuneFichierByName(Chemin, motif)
'copie de la derniere ligne du tableau dans l'historique des var
For I = 0 To 27
ws.Cells(k, I + 1).Value = Workbooks("LeFichier").Worksheets(LaFeuille).Cells(k, I + 1).Value
Next
MsgBox NomPlusJeuneFichierByName(Chemin, motif)
End Subtu voix donc que j'introduit le chemin et le motif .
peu etre que je le dit par ignorance et que ton code tient deja compte de tout ça
c'est vrai que j'ai une erreur là aussi l'indice n'appartient pas a la selection dans ma boucle for
merci d'avance
Re-,
Peux-tu faire une copie de ton fichier le plus récent, que tu déplaces dans un autre répertoire (la copie)
Tu vides toutes les données (sélectionne toutes les colonnes, et clic-droit, "Supprimer")
tu supprimes tous les autres onglets, sauf l'onglet "Historik"
Tu l'enregistres, le nommes comme tu le fais habituellement, et peux-tu l'envoyer?
voila le fichier est joint j'ai changé son nom et suprimé tous les autres onglets
merci encore
Re-,
Finalement, j'avais oublié une question.... (extension .xlsx et non .xls), mais j'aurais du le voir dans ton profil, que tu avais Excel 2007.....
Donc il a fallu repenser une bonne partie du code....
Jette tous les codes que tu avais avant
regarde le fichier joint, et fais un essai...
@ te relire