excel 2007 Importation depuis plusieurs fichiers

[francischristy]

Bonsoir,
J'utilise un fichier Excel 2003 avec importation de données "With Application.FileSearch". Cette application ne marche pas pour Excel 2007 malheureusement et je n'arrive pas à l'adapter. Pouvez-vous m'aider ?
Merci
Francis

 

[Pierrot93]

Re : excel 2007 Importation depuis plusieurs fichiers

Bonjour,

regarde peut être dans l'aide vba du coté de la fonction "Dir"... devrait peut être résoudre ton souci...

bonne journée
@+

 

[Dormeur74]

Re : excel 2007 Importation depuis plusieurs fichiers

Beaucoup de choses à dire sur ce code :
- il est très mal indenté : il y a des if emboîtés, on ne sait jamais où est la fin, etc.
- tu utilises des variables non déclarées, VB le permet, mais ne devrait pas.
Commence toujours par Option Explicit si tu ne l'as pas mis par défaut dans les options VBE.

Reprenons :
- on déclare obligatoirement les variables (ligne 1 : Option Explicit)
- on indente le code correctement pour que les blocs soient immédiatement visibles (If...Else...End, With et End With par exemple)
- pourquoi mettre dans le dur dans la feuille info le nom du dossier où se trouve Text.xls alors qu'il existe une instruction qui fait cela : ThisWorkBook.Path
- à quoi sert ce Else...Exit Sub à la fin puisque de toute manière on sort juste après.

Ce code fonctionne.

Option Explicit

Sub Auto_Data()
    Dim chemin, nomfichier, fichierlu, fenêtrelue As String
    Dim xvi3k1, xvi3k2, xvi3k3, xvi3k4, xvi3k5 As Variant
    Dim xvi3k6, xvi3k7, xvi3k8, xvi3k9, xvi3k10 As Variant
    Dim xvi3k11, xvi3k12, xvi3k13, xvi3k14, xvi3k15, xvi3k16 As Variant
    Dim sn_VI3, Date_VI3, Operator_VI3 As Variant
    Dim i As Long
    
    Application.ScreenUpdating = True
    Sheets("Data").Select
    Range("A2").Select
    chemin = ThisWorkbook.Path
    nomfichier = ActiveWorkbook.Name
    Range("A1").Select
    With Application.FileSearch
        .LookIn = chemin
        .SearchSubFolders = True
        .Filename = "ATR_Test*.xls"
        If .Execute > 0 Then
            Range("A2:AH1000").Select
            Selection.ClearContents
            Range("A2").Select
            For i = 1 To .FoundFiles.Count
                fichierlu = .FoundFiles(i)
                If Right(fichierlu, 3) = "xls" Then
                    Workbooks.Open Filename:=fichierlu, ReadOnly:=True
                    fenêtrelue = ActiveWorkbook.Name
                    Worksheets("Rev1").Activate
                    If ActiveSheet.Name <> "Rev1" Then
                        ActiveWindow.Close SaveChanges:=False
                        Exit Sub
                    End If
                    '  sélection à copier
                    sn_VI3 = Range("G2").Value 'Serial Number
                    Date_VI3 = Range("G3").Value 'Date
                    Operator_VI3 = Range("B3").Value 'Operator
                
                    xvi3k1 = Range("D5").Value
                    xvi3k2 = Range("D6").Value
                    xvi3k3 = Range("D7").Value
                    xvi3k4 = Range("D8").Value
                    xvi3k5 = Range("D10").Value
                    xvi3k6 = Range("D11").Value
                    xvi3k7 = Range("D12").Value
                    xvi3k8 = Range("D13").Value
                    xvi3k9 = Range("D14").Value
                    xvi3k10 = Range("D16").Value
                    xvi3k11 = Range("D17").Value
                    xvi3k12 = Range("D18").Value
                    xvi3k13 = Range("D19").Value
                    xvi3k14 = Range("D20").Value
                    xvi3k15 = Range("D21").Value
                    xvi3k16 = Range("D22").Value
                               
                    ActiveWindow.Close SaveChanges:=False
                
                    'mettre à la suite
                    ActiveCell.Value = sn_VI3
                    ActiveCell.Offset(0, 1).Value = Date_VI3
                    ActiveCell.Offset(0, 2).Value = Operator_VI3
                    ActiveCell.Offset(0, 3).Value = xvi3k1
                    ActiveCell.Offset(0, 4).Value = xvi3k2
                    ActiveCell.Offset(0, 5).Value = xvi3k3
                    ActiveCell.Offset(0, 6).Value = xvi3k4
                    ActiveCell.Offset(0, 7).Value = xvi3k5
                    ActiveCell.Offset(0, 8).Value = xvi3k6
                    ActiveCell.Offset(0, 9).Value = xvi3k7
                    ActiveCell.Offset(0, 10).Value = xvi3k8
                    ActiveCell.Offset(0, 11).Value = xvi3k9
                    ActiveCell.Offset(0, 12).Value = xvi3k10
                    ActiveCell.Offset(0, 13).Value = xvi3k11
                    ActiveCell.Offset(0, 14).Value = xvi3k12
                    ActiveCell.Offset(0, 15).Value = xvi3k13
                    ActiveCell.Offset(0, 16).Value = xvi3k14
                    ActiveCell.Offset(1, 0).Select
                End If
            Next i
        End If
    End With
End Sub

 

[Pierrot93]

Re : excel 2007 Importation depuis plusieurs fichiers

BONJOUR Dormeur,

Ce code fonctionne.

pas sous 2007...

 

[Dormeur74]

Re : excel 2007 Importation depuis plusieurs fichiers

pas sous 2007...

Je suis sous 2003. Peux-tu nous dire sur quelle ligne ça plante ?

 

[francischristy]

Re : excel 2007 Importation depuis plusieurs fichiers

Bonjour Dormeur et Pierrot, Merci pour votre réponse,
Ce code fonctionne en 2007, mais pas pour des sous-dossiers avez-vous une idée.

Sub Open_All_Files()
Dim oWbk As Workbook
Dim SFIL As String
Dim SPath As String
Dim xx1_sn As String
Range("A2").Select
SPath = "C:\Users\Documents\Getway\test\" 'location of files
ChDir SPath

SFIL = Dir("ATR_*.xls") 'change or add formats
'*************************

'***************************
Do While SFIL <> "" 'will start LOOP until all files in folder sPath have been looped through

Application.DisplayAlerts = False

Set oWbk = Workbooks.Open(SPath & "\" & SFIL)
'.SubFolders = True

xx1_sn = Range("B8").Value

oWbk.Close True 'close the workbook, saving changes
ActiveCell.Value = xx1_sn

ActiveCell.Offset(1, 0).Select
SFIL = Dir
Loop ' End of LOOP

End Sub

Merci ......................

 

[Dormeur74]

Re : excel 2007 Importation depuis plusieurs fichiers

Pour moi (Excel 2003), ce code fonctionne normalement (à condition que le degré de protection des fichiers ATR_*.xls le permette). Inutile de mettre ce ChDir SPath qui ne sert à rien.

Pourrais-tu introduire une gestion d'erreur dans ton code et nous donner le n° de l'erreur ?

Option Explicit

Sub Open_All_Files()
    Dim oWbk As Workbook
    Dim SFIL As String
    Dim SPath As String
    Dim xx1_sn As String
    
    On Error GoTo GESTERREUR
    Range("A2").Select
    SPath = "C:\Users\Documents\Getway\test\" 'location of files
    'ChDir SPath

    SFIL = Dir(SPath & "ATR_*.xls") 'change or add formats
    
    Do While SFIL <> "" 'will start LOOP until all files in folder sPath have been looped through

        Application.DisplayAlerts = False

        Set oWbk = Workbooks.Open(SPath & "\" & SFIL)
        xx1_sn = Range("B8").Value
        oWbk.Close True 'close the workbook, saving changes
        
        ActiveCell.Value = xx1_sn

        ActiveCell.Offset(1, 0).Select
        SFIL = Dir
    Loop ' End of LOOP
    Exit Sub

GESTERREUR:
    MsgBox "Erreur n° " & Err.Number & "   Description : " & Err.Description

End Sub