[VB6]Lecture dans fichier puis récuperation dans un tableur

Version imprimable

05/06/2013, 09h33
Pexou

[VB6]Lecture dans fichier puis récuperation dans un tableur

Bonjour a tous,

je viens vers vous afin de savoir si ce genre de programme est réalisable, je vous explique :

je souhaite creer un petit programme sous VB6 qui me permettrai de lire dans un fichier excel une cellule et la reporter dans un nouveau tableur.
Le soucis vient du fais que dans se repertoir il y a beaucoup de fichier excel avec des nomenclatures complétement différente.

de maniére syntaxique je souhaite :

le programme lis dans le repertoire les fichiers excel puis ecris dans un nouveau classue excel le nom du fichier avec en face la cellule spécifique que l'on souhaite recuperer, creant une liste dans un nouveau classeur de tous les fichiers correspondant au repertoire et la cellule cible.

en esperant avoir été assez explicit.

Cordialement

Pex
05/06/2013, 21h32
SfJ5Rpw8

Bonjour,

décompose ton programme en tâches élémentaires et dis nous sur laquelle tu bloque ..
06/06/2013, 08h48
Pexou

Citation:

Envoyé par bbil

Bonjour,

décompose ton programme en tâches élémentaires et dis nous sur laquelle tu bloque ..

alors la ou je coince c'est pour lire les fichiers contenue dans le dossier puis d'en extraire leur nom et les mettre dans excel ... j'ai essayer avec certains exemple mais je n'arrive pas a comprendre les syntaxe ... j'ai lu les pdf mais sachant que la prommagation n'"est pas du tout dans mes connaissance je rame beaucoup, faut se l'avouer ! Je suis un scientifique de labo et non un peu génie de l'informatique ...

je suis novice dans se domaine j'ai compris certains code par la logique du langage mais je n'ai pas les expressions ...

je demande pas un code fait pour moi mais des exemples pour m'en inspirer et le modifier !! on apprend par l'erreur donc je suis preneur :)

j'ai un code partielle mais en VBA et non en VB6.

Cordialement

pex

Pour manipuler les fichiers (liste, copie, suppression etc...) tu peux utiliser fso :

Il faut d'abord ajouter une référence dans VB6 :

Citation:

Quelle référence dois-je ajouter à mon projet pour pouvoir utiliser le FileSystemObject ?

Dans le Menu Projet >> Références >> Ajoutez la librairie Microsoft Scripting Runtime. Le fichier correspondant se nomme scrrun.dll

Avec la référence :
Code:

1 2 Dim objFSO As Scripting.FileSystemObject Set objFSO = New Scripting.FileSystemObject
OU

Déclaration sans ajouter la référence :

Code:

Set objFSO = CreateObject("Scripting.FileSystemObject")

Commande pour lister un dossier :
Code:

1 2 Dim Rep As Scripting.Folder Set Rep = objFSO.GetFolder("C:\chemin_dossier_a_lister")
Parcourir les fichiers du dossier listé :
Code:

1 2 3 4 5 6 7 8 9 Dim Fich As Scripting.File For Each Fich In Rep.Files If Right(Fich.Name, 4) = ".xls" Then '--> Fich.Name 'Ouvrir chaque fichier Excel faire les manips avec le tuto qui suit 'Déclarer tous les objets Excel à l'extérieur de cette boucle --> Appel constructeur et destructeur. End If Next
Détruire FSO (A mettre en fin de programme <=> permet de libérer la mémoire quand on a terminé avec) :

Code:

Set objFSO = Nothing

:!: :!: :!: Voici un tuto pour manipuler Excel avec VB : :!: :!: :!:
:!: :!: :!: http://drq.developpez.com/vb/tutoriels/Excel/ :!: :!: :!:

Ensuite poste le code que tu as pu écrire lorsque tu bloque 8-)

06/06/2013, 21h13
SfJ5Rpw8

Bonsoir,

Pour lister les fichiers d'un répertoire un simple dir suffit..

http://vb.developpez.com/faq/?page=F...mpteFichierRep

merci de cette aide ...

merci pour utiliser les filesystemOject FSO.

voici mon code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Private Sub Command1_Click()
Dim oExcel As Excel.Application
Dim oWk As Workbook
Dim dest As Range
Dim objFSO As Scripting.FileSystemObject
Dim Rep As Scripting.Folder
Dim Fich As Scripting.File
 
Set objFSO = New Scripting.FileSystemObject
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
 
Set Rep = objFSO.GetFolder("\\Mon_rep_a_lister")
 
     Set oExcel = CreateObject("Excel.Application")
    oExcel.Visible = False 'Masque l'application excel (valeur par défaut)
    On Error Resume Next 'Pour éviter les erreur si classeur n'existe pas
    Set oWk = oExcel.Workbooks.Open("\mon_rep\suivi.xlsx")
    On Error GoTo 0
    If oWk Is Nothing Then
      MsgBox "Erreur sur ouverture classeur fichier inexistant ", vbCritical
      Exit Sub
    End If
 
  Set dest = oWk.Sheets("feuil1").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
 
For Each Fich In Rep.Files
   If Right(Fich.Name, 4) = ".xlsx" Then
   dest.Offset(1, 1).Value = Fich.Name
   End If
Next
 
Set objFSO = Nothing
 
    oWk.Save
    oWk.Close False 'Ferme le classeur
    oExcel.Quit
    Set oWk = Nothing
    Set oExcel = Nothing 'libération mémoire..
 
end sub

sa ne marche pas :(

les dossiers est bien pointé mais je n'ai pas la valeur qui se retourne dans mon excel

1ere erreur repérée :
Code:

1 2 3 4 5 For Each Fich In Rep.Files If Right(Fich.Name, 4) = ".xlsx" Then dest.Offset(1, 1).Value = Fich.Name End If Next
Il faut mettre 5 car ton extension fait 5 caractères (.xlsx) :

Code:

If Right(Fich.Name, 5) = ".xlsx" Then

Du coup tu ne passe jamais dans le condition, et cette commande :

Code:

dest.Offset(1, 1).Value = Fich.Name

n'est jamais exécutée ! Tu peux le constater en mettant un point d'arrêt dessus --> ça ne s'arrête jamais avec la valeur 4. ;)

Cette commande dans ton cas n'est pas propre, if faut tester si le fichier existe :

Code:

On Error Resume Next 'Pour éviter les erreur si classeur n'existe pas

Fais plutôt :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 if objFSO.FileExists("\mon_rep\suivi.xlsx") then Set oWk = oExcel.Workbooks.Open("\mon_rep\suivi.xlsx") On Error GoTo 0 If oWk Is Nothing Then MsgBox "Erreur sur ouverture classeur fichier inexistant ", vbCritical Exit Sub End If Set dest = oWk.Sheets("feuil1").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) For Each Fich In Rep.Files If Right(Fich.Name, 4) = ".xlsx" Then dest.Offset(1, 1).Value = Fich.Name End If Next End if
C'est objFSO.FileExists ou objFSO.Exist("chemin") --> à voir avec l'intellisense si tu as activé la référence dans VB.

Ensuite pour
Code:

1 2 3 Set objFSO = New Scripting.FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject")
Les deux commandes font la même chose ! Donc tu ne mets qu'une des 2.
"Set objFSO = New Scripting.FileSystemObject" --> Si tu as ajouté la référence à fso dans VB
"Set objFSO = CreateObject("Scripting.FileSystemObject")" --> Si tu n'as pas ajouté la référence.

C'est le même principe pour Excel...

Je te conseille d'ajouter les références pour profiter de "l'intellisense" c'est à dire le "menu déroulant" qui apparait pour te proposer les méthodes disponibles sur les objets...

Pour ce code :
Code:

1 2 3 4 5 For Each Fich In Rep.Files If Right(Fich.Name, 5) = ".xlsx" Then dest.Offset(1, 1).Value = Fich.Name End If Next
Tu veux surement ajouter le nom de plusieurs fichiers dans ton Offset Excel, il faut faire une concaténation :

Code:

dest.Offset(1, 1).Value = dest.Offset(1, 1).Value & Fich.Name & VbCrLf

"VbCrLf" = retour chariot

PS : Désolé s'il y a des erreurs de syntaxe ça fait des plombes que je n'ai pas codé en VB6 ;)

merci beaucoup pour tes explications ..
cela marche casi parfaitemement ...

tous les noms des fichiers figure dans une seul cellule de excel .
j'aurai voulu savoir comment faire pour que chaque nom de fichier soit sur une ligne différente ...

le code marche bien mais j'aurai voulu car je dois extraire une cellule dans chaque fichier ( quantité restante en H8 ) qui se rajouté dans la colonne a coté du nom du fichier !!
se sont tous des fichiers excel ! merci beaucoup

je vous joints mon code VBa pour vous montrer :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Sub importDonnees()
 
Dim principal As ThisWorkbook
Dim indice As Integer
Dim repertoire As String
Dim fichier As String
Dim Feuille As Worksheet
 
    Application.ScreenUpdating = True
    Set principal = ThisWorkbook
    repertoire = ThisWorkbook.Path + "\"
 
 
 
    ChDir repertoire
    ' fichier = Dir("*.xlsx")
    fichier = Dir(repertoire + "\*.xlsx")
 
    On Error Resume Next
    principal.Sheets("suivi matiére").Delete
    Application.DisplayAlerts = True
 
    On Error GoTo 0
 
    Set NewSheet = principal.Sheets.Add(After:=Worksheets(Worksheets.Count), Type:=xlWorksheet)
    NewSheet.Name = "suivi matiére"
 
    indice = 1
    Do While fichier <> ""
        If fichier <> principal.Name Then
            Workbooks.Open repertoire + "\" + fichier
 
            principal.Sheets("suivi matiére").Cells(indice, 1).Value = ActiveWorkbook.Name
            principal.Sheets("suivi matiére").Cells(indice, 2).Value = ActiveWorkbook.ActiveSheet.Cells(5, 8).Value
            ActiveWorkbook.Close False
        End If
        fichier = Dir
        indice = indice + 1
    Loop
 
End Sub

voila merci de votre soutien