[XL365]Lister fichier, extraire données et reintégrer dans un fichier
Bonjour,
Je suis désolé je suis complètement novice... J'ai essayé de faire des recherches mais ma solution a l'air de se trouver dans plusieurs topics et je suis perdu, surtout qu'apparemment il existe plusieurs solutions à chaque fois...
La problématique :
Nous récupérons un fichier Excel de chaque fournisseur avec des commissions que l'on doit leur payer.
Je dois donc lister les fichiers présents dans mon répertoire et ensuite récupérer sur chaque fichiers Excel la donnée qui se trouve dans la dernière ligne de la colonne S (le montant de la commission) et le nombre de ligne est aléatoire selon les fichiers (il varie en fonction du nombre d'acte).
Je dois également prendre la donnée de la cellule A1 qui sera de ce type : ENC005426202/08/2018 et en extraire ce code 0054262 qui est le numéro du fournisseur.
Il faudra ensuite que je compare ce code fournisseur avec un autre fichier pour le convertir car en local nous n'avons pas la même codification.
Ensuite je réintègre le montant de la commission et le code fournisseur convertit vers un nouveau tableau Excel pour pouvoir l'importer en comptabilité.
J'espère être assez claire...
On m'a aidé avec ce code :
Sub TestADO()
Dim Tbl() As String
Dim T
Dim Chemin As String
Dim I As Integer
Chemin = "C:\Dossier\" '<adapte le chemin du dossier !
Tbl() = RecupFichiers(Chemin)
If Not Not Tbl Then
For I = 1 To UBound(Tbl)
T = Split(Recup(Chemin, Tbl(I)), ";") '<--- adapter le séparateur si ce n'est pas le ;
With ThisWorkbook.Worksheets("Feuil1"): .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1).Value = T(18): End With
Next I
End If
End Sub
Private Sub ConnectCLasseur(ConnectCL As Object, _
Dossier As String, _
Optional Rs)
Set ConnectCL = CreateObject("ADODB.Connection")
If Not IsMissing(Rs) Then Set Rs = CreateObject("ADODB.Recordset")
ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Dossier & ";" & _
"Extended Properties=""text;HDR=YES;FMT=Delimited;"""
End Sub
Function Recup(Dossier As String, Fichier As String)
Dim Connect As Object
Dim Rs As Object
Dim Valeur As String
'ouvre une première connexion pour la recherche
ConnectCLasseur Connect, Dossier, Rs
'ouvre pour récupérer les valeurs
With Rs
.Open "SELECT * FROM [" & Fichier & "]", Connect, 3, 1, 1
.MoveLast 'va à la dernière ligne
Valeur = .Fields(0).Value
End With
'ferme la connexion
Connect.Close
Set Connect = Nothing
Set Rs = Nothing
Recup = Valeur
End Function
Function RecupFichiers(Chemin As String) As String()
Dim TableauFichiers() As String
Dim Fichier As String
Dim I As Integer
Fichier = Dir(Chemin & "*.csv")
Do While (Len(Fichier) > 0)
I = I + 1
ReDim Preserve TableauFichiers(1 To I)
TableauFichiers(I) = Fichier
Fichier = Dir()
Loop
RecupFichiers = TableauFichiers()
End FunctionLe problème est qu'il ne récupère que l'entier de la valeur et non la partie décimale.
Si quelqu'un a une solution, ça serait très apprécié !
J'aimerais réussir à mettre ceci en place car nous recevons en moyenne 400 fichiers tous les mois et à la main ça prend un temps monstrueux ! Et l’entreprise étant récente, chaque mois le nombre de fichiers augmente…
Merci par avance.
Cordialement.
Hyuntrax
Bonjour
@hyuntrax
Ce problème est déjà posté sur un autre forum où ce code a été donné après que tu aies fourni un fichier
Celui qui a donné le code a indiqué qu'il travaillait à rechercher pourquoi les données situées après la virgule ne sont pas restituées.
La moindre des choses serait de nous préciser ce multipost et de joindre également le fichier...
bonjour
extraire des données de 400 fichiers ou même 10 000 est un job pour PQuery et non VBA depuis bientôt 10 ans !
- télécharger Power Query (mais i intégré à Excel versions suivant la tienne)
- activer cet add-on
- menu Power Query
- récupérer de Dossier
ensuite tout dépend de la structure des fichiers (en admettant qu'ils ont tous la même, sinon galère pour 400 ! )
joins un fichier, on va voir
RE
- télécharger Power Query (mais i intégré à Excel versions suivant la tienne)
- activer cet add-on
365 est la toute dernière version d'Excel (la plus à jour de 2016) donc c'est intégré.
Je remarque que tu l'as !
Edit : A noter que seules 2 cellules sont à recupérer dans chaque fichier qui ne sont pas des listes de données puisque synthèse en bas de liste
Bonjour,
J'avais précisé qu'on m'a aidé avec ce code mais effectivement, pas qu'il existait un autre post, désolé pour ceci.
Je joins les fichiers.
@jmd : la structure n'est pas tout à fait la même car la dernière cellule active de la colonne S n'est pas forcement la même selon les fichiers. Est-ce que c'est tout de même gérable ?
Merci !
RE
C'est une problème de séparateur par défaut.
La colonne S étant pour moi non récupérable, la colonne V est-elle toujours égale à S au signe près ?
Re !
Oui je viens de regarder pas mal de factures et effectivement le montant est normalement toujours identique au signe près. Ou alors ce serait vraiment un cas isolé car il faudrait qu'on ai reçu un acompte du montant de la commission en S ce qui n'arrive pas dans 99,99% des cas.
Donc si pour faciliter on peut prendre la colonne V et supprimer le signe, c'est tout autant efficace.
RE
Une sub ajoute un fichier schema.ini avant chaque ouverture de csv pour changer le séparateur par défaut
Cela implique d'autres changements dans le code. Voici l'ensemble
Edit : ajouter la référence Microsoft Scripting Runtime
Sub TestADO()
Dim Tbl() As String
Dim T
Dim Chemin As String
Dim I As Integer
Chemin = "C:\TEST\" '<adapte le chemin du dossier !
Tbl() = RecupFichiers(Chemin)
If Not Not Tbl Then
For I = 1 To UBound(Tbl)
T = Split(Recup(Chemin, Tbl(I)), "-") '<--- adapter le séparateur si ce n'est pas le ;
With ThisWorkbook.Worksheets("Feuil1")
.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1).Value = Left(T(0), Len(T(0)) - 10)
.Cells(.Cells(.Rows.Count, 2).End(xlUp).Row + 1, 2).Value = T(1) * 1
End With
Next I
End If
End Sub
Private Sub ConnectCLasseur(ConnectCL As Object, _
Dossier As String, _
Optional Rs)
Set ConnectCL = CreateObject("ADODB.Connection")
If Not IsMissing(Rs) Then Set Rs = CreateObject("ADODB.Recordset")
ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Dossier & ";" & _
"Extended Properties=""text;HDR=YES;FMT=Delimited();"""
End Sub
Function Recup(Dossier As String, Fichier As String)
Dim Connect As Object
Dim Rs As Object
Dim Valeur1 As String
Dim Valeur2 As Double
'ouvre une première connexion pour la recherche
ConnectCLasseur Connect, Dossier, Rs
'ouvre pour récupérer les valeurs
With Rs
Call fncWriteSchmIni(Dossier, Fichier)
.Open "SELECT * FROM [" & Fichier & "]", Connect, 3, 1, 1
.MoveLast 'va à la dernière ligne
Valeur1 = .Fields(0).Value
Valeur2 = Abs(.Fields(21).Value)
End With
'ferme la connexion
Connect.Close
Set Connect = Nothing
Set Rs = Nothing
Recup = Valeur1 & "-" & Valeur2
End Function
Function RecupFichiers(Chemin As String) As String()
Dim TableauFichiers() As String
Dim Fichier As String
Dim I As Integer
Fichier = Dir(Chemin & "*.csv")
Do While (Len(Fichier) > 0)
I = I + 1
ReDim Preserve TableauFichiers(1 To I)
TableauFichiers(I) = Fichier
Fichier = Dir()
Loop
RecupFichiers = TableauFichiers()
End Function
Private Sub fncWriteSchmIni(Dossier, Fichier)
' Requires Microsoft Scripting Environment
Dim varFSO As FileSystemObject
Dim varStrm As TextStream
Dim varFL As File
Set varFSO = New FileSystemObject
'Verif Existence fichier
If varFSO.FileExists(Dossier & "\schema.ini") Then varFSO.DeleteFile (Dossier & "\schema.ini")
'create the file in the source directory
Set varStrm = varFSO.CreateTextFile(Dossier & "\schema.ini", True)
'write the specifications needed
varStrm.Write "[" & Fichier & "]" & Chr(13) & Chr(10) & _
"ColNameHeader = False" & Chr(13) & Chr(10) & _
"Format = Delimited(;)"
Set varFL = varFSO.GetFile(gvarSrcDir & "\schema.ini")
End SubRE
Une sub ajoute un fichier schema.ini avant chaque ouverture de csv pour changer le séparateur par défaut
Cela implique d'autres changements dans le code. Voici l'ensemble
Edit : ajouter la référence Microsoft Scripting Runtime
Sub TestADO() Dim Tbl() As String Dim T Dim Chemin As String Dim I As Integer Chemin = "C:\TEST\" '<adapte le chemin du dossier ! Tbl() = RecupFichiers(Chemin) If Not Not Tbl Then For I = 1 To UBound(Tbl) T = Split(Recup(Chemin, Tbl(I)), "-") '<--- adapter le séparateur si ce n'est pas le ; With ThisWorkbook.Worksheets("Feuil1") .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1).Value = Left(T(0), Len(T(0)) - 10) .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row + 1, 2).Value = T(1) * 1 End With Next I End If End Sub Private Sub ConnectCLasseur(ConnectCL As Object, _ Dossier As String, _ Optional Rs) Set ConnectCL = CreateObject("ADODB.Connection") If Not IsMissing(Rs) Then Set Rs = CreateObject("ADODB.Recordset") ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & Dossier & ";" & _ "Extended Properties=""text;HDR=YES;FMT=Delimited();""" End Sub Function Recup(Dossier As String, Fichier As String) Dim Connect As Object Dim Rs As Object Dim Valeur1 As String Dim Valeur2 As Double 'ouvre une première connexion pour la recherche ConnectCLasseur Connect, Dossier, Rs 'ouvre pour récupérer les valeurs With Rs Call fncWriteSchmIni(Dossier, Fichier) .Open "SELECT * FROM [" & Fichier & "]", Connect, 3, 1, 1 .MoveLast 'va à la dernière ligne Valeur1 = .Fields(0).Value Valeur2 = Abs(.Fields(21).Value) End With 'ferme la connexion Connect.Close Set Connect = Nothing Set Rs = Nothing Recup = Valeur1 & "-" & Valeur2 End Function Function RecupFichiers(Chemin As String) As String() Dim TableauFichiers() As String Dim Fichier As String Dim I As Integer Fichier = Dir(Chemin & "*.csv") Do While (Len(Fichier) > 0) I = I + 1 ReDim Preserve TableauFichiers(1 To I) TableauFichiers(I) = Fichier Fichier = Dir() Loop RecupFichiers = TableauFichiers() End Function Private Sub fncWriteSchmIni(Dossier, Fichier) ' Requires Microsoft Scripting Environment Dim varFSO As FileSystemObject Dim varStrm As TextStream Dim varFL As File Set varFSO = New FileSystemObject 'Verif Existence fichier If varFSO.FileExists(Dossier & "\schema.ini") Then varFSO.DeleteFile (Dossier & "\schema.ini") 'create the file in the source directory Set varStrm = varFSO.CreateTextFile(Dossier & "\schema.ini", True) 'write the specifications needed varStrm.Write "[" & Fichier & "]" & Chr(13) & Chr(10) & _ "ColNameHeader = False" & Chr(13) & Chr(10) & _ "Format = Delimited(;)" Set varFL = varFSO.GetFile(gvarSrcDir & "\schema.ini") End Sub
Bonjour,
Je ne sais pas ce qu'il faut récupérer pour ceci
'Requires Microsoft Scripting Environment
Quand je vais des recherches ça me renvoi à powershell ou ISEfile.
Pourrais tu m'indiquer ou récupérer les fichiers nécessaires pour faire fonctionner le script stp ?
Merci !
BOnjour
Dans l'éditeur VBA : Outils, Références. Tu cherches la ligne Microsoft Scripting Runtime et tu la coches
re
resalut Chris
avec PQuery, on récupère tout le contenu d'une feuille dans chaque fichier
ensuite, toujours dans PQuery, soit la ligne voulue est facilement repérable (par exemple, sa col A et sa col B sont vides) et on supprime toutes les autres lignes
soit, la cellule cible est une somme d'une colonne, alors on refait la somme ! ce qui est plus fiable. Mais suppose encore de supprimer des lignes par rapport à leur contenu
on cause, on cause, mais ya pas de fichier exemple joint !
comment t'aider ?
re
resalut Chris
avec PQuery, on récupère tout le contenu d'une feuille dans chaque fichier
ensuite, toujours dans PQuery, soit la ligne voulue est facilement repérable (par exemple, sa col A et sa col B sont vides) et on supprime toutes les autres lignes
soit, la cellule cible est une somme d'une colonne, alors on refait la somme ! ce qui est plus fiable. Mais suppose encore de supprimer des lignes par rapport à leur contenu
on cause, on cause, mais ya pas de fichier exemple joint !
comment t'aider ?
Salut
La ligne est toujours la dernière de la colonne S mais ce n'est pas forcement toujours la même ligne car le nombre d'info dans le tableau est aléatoire et ce n'est pas la somme de la colonne.
Pour les fichiers exemples, je les ai mis dans une réponse précédente sous le nom de vba.zip. Il y a dedans 3 fichiers exemple et le fichier macro qui contient le code vba.
Merci à la communauté pour l'aide !
Là je vais essayer d'activer la fonction dans excel et tester le code qu'on m'a donné précédemment.
Je vous tiens au courant !!
Re
avec PQuery, on récupère tout le contenu d'une feuille dans chaque fichier...
...on cause, on cause, mais y a pas de fichier exemple joint !
Si il y a eu un zip dans la discussion.
Le problème c'est que 400 fichiers bout à bout, risque de saturer PowerQuery, non ?
De plus les 2 valeurs à récupérer sont pour l'une dans la colonne A pour l'autre SOUS un libellé en fin d'une colonne de chiffres donc pas du tout selon un format table
Le code que j'ai donné fonctionne parfaitement sur les 3 fichiers du Zip
Mais si tu as une solution PQ poste-là car je n'ai pas trouvé pour ma part...
Edit : télescopage avec hyuntrax qui répondais en même temps que moi
BOnjour
Dans l'éditeur VBA : Outils, Références. Tu cherches la ligne Microsoft Scripting Runtime et tu la coches
Je ne peux pas activer la fonction car la ligne référence dans outils est grisé...
Désolé d'être aussi mauvais !
Je vais chercher sur google si je trouve un truc...
Sinon vous aurez le droit de me lyncher à force !
BOnjour
Dans l'éditeur VBA : Outils, Références. Tu cherches la ligne Microsoft Scripting Runtime et tu la coches
Je ne peux pas activer la fonction car la ligne référence dans outils est grisé...
Désolé d'être aussi mauvais !
Je vais chercher sur google si je trouve un truc...
Sinon vous aurez le droit de me lyncher à force !
Bon j'ai réussi au moins à faire ça !
fallait cliquer sur stop...
voila voila voila
Ok donc la fonction est activée,
Le code a l'air de s’exécuter correctement, il me créait bien le fichier schéma.ini.
Par contre il me marque un message d'erreur d’exécution 53 "fichier introuvable"
Quand ça veut pas, ça veut pas !
Re
Par contre il me marque un message d'erreur d’exécution 53 "fichier introuvable"
Sur quelle ligne ?
J'ai fait débogage et cette ligne était surligné en jaune.
Set varFL = varFSO.GetFile(gvarSrcDir & "\schema.ini")C'est la dernière avant de fermer la dernière balise.
Re
Remplace gvarSrcDir par Dossier
Il me semblait l'avoir changé...
Edit : Je crois que cette ligne est facultative : tu peux aussi essayer de la mettre en commentaire car cette variable n'est pas utilisée (j'ai adapté un code trouvé sur le net pour créer ce Schema.ini)
Merci ça fonctionne !!
Je vais essayer de me débrouiller pour la suite et je reviendrai si je m'en sors pas...en gros je vous dis à bientôt ! mdr
C'est super d'avoir une communauté comme ça.
Vous avez mis combien de temps pour avoir assez de notion pour créer ce genre de code ?
Cordialement
Hyuntrax