IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Erreur 1004, fichier introuvable trouvé


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Candidat au Club
    Profil pro
    Inscrit en
    Juillet 2011
    Messages
    2
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juillet 2011
    Messages : 2
    Par défaut Erreur 1004, fichier introuvable trouvé
    Bonjour, j'ai un problème incohérent avec mon programme qui demande à ouvrir des fichiers dans un dossier. J'ai fais une boucle pour savoir s'il trouvait des fichiers dans le dossier et il me dit que non... (alors que j'ai 2 fichiers dans le dossier spécifié). Sans la boucle, j'ai le message d'erreur suivant:
    "Erreur d'exécution '1004':

    'fichier1.xls' introuvable. Vérifier l'orthographe du nom du classeur et la validité de l'emplacement."
    Il me nomme le premier fichier et dit qu'il est introuvable alors que je ne l'ai jamais nommé dans le programme...

    Y aurait-il une erreur dans l'appellation des fichiers?
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    Sub Importfiles()
    Set wbdest = ActiveWorkbook
    Dim test As String
     
    fichier = Dir("E:\test\*.xls") 'définit les fichiers à importer en l’occurence tous les fichiers excel se trouvant dans ce répertoire
     
    'test = fichier
    'If Dir(test, vbDirectory) = "" Then
    '    MsgBox "fichier non trouvé"
    'Else
     
    Do While fichier <> "" 'démarre la boucle jusqu’au dernier fichier disponible dans le répertoire
        Set wbsource = Workbooks.Open(fichier) 'ouvre le fichier actuel à importer
        Set wksNewSheet = wbsource.Sheets("sheet1") 'sélectionne la feuille de données à importer
        wksNewSheet.Activate 'active cette feuille
        wksNewSheet.Select
        Range(Cells(2, 1), Cells(3, 3)).Select 'selection des données que l’on veut importer
        Selection.Copy 'copie les données sélectionnées
        wbdest.Activate 'retourne vers le fichier de départ
        i = ActiveSheet.UsedRange.Rows.Count 'compte le nombre de lignes déjà utilisées dans ce fichier
        Cells(i + 1, 1).Select 'sélection de la cellule où on veut coller les données (la première vide)
        ActiveSheet.Paste 'colle les données
        wbsource.Close 'ferme le fichier source
        fichier = Dir 'va vers le fichier suivant à importer
        Loop 'recommece la boucle avec le fichier suivant
        wbdest.Activate
    'End If
    End Sub
    Merci d'avance.

  2. #2
    Expert confirmé Avatar de jfontaine
    Homme Profil pro
    Contrôleur de Gestion
    Inscrit en
    Juin 2006
    Messages
    4 756
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 51
    Localisation : France, Sarthe (Pays de la Loire)

    Informations professionnelles :
    Activité : Contrôleur de Gestion

    Informations forums :
    Inscription : Juin 2006
    Messages : 4 756
    Par défaut
    Bonjour,


    Pas vraiment académique comme méthode.
    Je te conseil d'utiliser FSO pour l'accès aux fichiers d'un répertoire

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    Dim Fso As Object
    Dim FsoRepertoire As Object
    Dim FsoFichier As Object
    Dim i As Long
     
    Dim str() As String
     
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set FsoRepertoire = Fso.GetFolder("C:\")
     
    'Boucle sur fichiers du repertoire
    i = 1
    For Each FsoFichier In FsoRepertoire.Files
        str = Split(FsoFichier.Name, ".")
        If str(UBound(str)) = "xls" Then
     
             'Traitement d'importation
     
     
            i = i + 1
        End If
    Next

  3. #3
    Membre éprouvé Avatar de Vadorblanc
    Profil pro
    Inscrit en
    Février 2008
    Messages
    309
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2008
    Messages : 309
    Par défaut
    Bonjour

    J'utilise souvent cette macro magnifique brodée par des pros du forum qui boucle sur tous les fichiers d'un répertoire, et qui nécessite seulement d'activer la reférence "Microsoft Scripting RunTime" par VBA > Outils Références cocher Microsoft Scripting RunTime.
    Adapte là pour tes besoins. Fonctionne sur Excel 2003.
    Cordialement



    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    Option Explicit
    Sub Module10ConcatenerRépertoire()
     
     
    'Declaration des variables
    Dim Classeur_Maitre As Workbook, Classeur_Slave As Workbook
    Dim oShell As Object, oFolder As Object
    Dim oFolderItem As Object
    Dim Tab_Files As Variant
    Dim aFile As Variant
    Dim ValueB7 As String 'si le contenu de la cellule B7 est numerique mettre Long ou integer a la place de string
    Dim Cel As Range
    Application.DisplayAlerts = False
    Set Classeur_Maitre = ActiveWorkbook
    Set oShell = CreateObject("Shell.Application")
    Set oFolder = oShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
    If oFolder Is Nothing Then
        MsgBox "Abandon opérateur", vbCritical
        Exit Sub
    Else
      Set oFolderItem = oFolder.Self
      'MsgBox oFolderItem.Path
    End If
    'Fin du morceau pioché
    'On recupert les fichier contenu dans le repertoire en question
    Tab_Files = ListFilesInFolder(oFolderItem.Path, False) 'mettre true a la place de false pour regarder les sous repertoires et rajouter une liste d'extension pour limiter les fichiers listés (,"txt;ert;doc;xls")
    For Each aFile In Tab_Files
    '................................................................................................................
        Set Classeur_Slave = Workbooks.Open(aFile, ReadOnly:=True)
        'Ouvre classeur Slave sheet 1 et copie la cellule
         Classeur_Slave.Sheets(1).Select
         Selection.AutoFilter Field:=4  'Enlever les filtres
                Rows("7:7").Select
                Selection.AutoFilter
        Classeur_Slave.Sheets(1).Range("C2").Copy
        'Sélectionne la sheet 2
        With Classeur_Slave.Sheets(1)
                'Colle cellule à la 8è ligne en collage spécial valeurs si cellule A8 adjacente non vide
                For Each Cel In .Range(.Cells(8, "A"), .Cells(Rows.Count, "A").End(xlUp))
                If Cel <> "" Then Cel.Offset(0, 62).PasteSpecial Paste:=xlPasteValues
            Next Cel
        End With
       Classeur_Slave.Sheets(1).Range("A8:BK1100").Copy
      'Copie E4:AT100 du classeur Slave et le colle en collage spécial valeurs dans le Classeur Maitre de la sheet 2
        With Classeur_Maitre.Sheets(2).Range("A65536").End(xlUp)
                .Offset(1, 0).Value = Classeur_Slave.Name
                .Offset(2, 0).PasteSpecial Paste:=xlValues 'colle à la 2è ligne vers le bas
     
        End With
    '...................................................................................................................
        Classeur_Slave.Close False
    Next
    '.....................................................................................................................
    'macro à mettre ici pour ce que tu souhaites faire
    '
    '
    '
    '
    '
    '
    '
    'Sheets("Base").Copy  'Edition Déplacer ou copier une feuille sur autre classeur
     
    'With ThisWorkbook
    '    .Saved = True  'ne pas enregistrer
    '    .Close         'ferme le fichier macros
    End With
    End Sub
    Function ListFilesInFolder(strFolderName As String, Optional bIncludeSubfolders As Boolean = False, Optional strTypeFichier As String) As Variant
      '
      ' necessite d'activer la reference Microsoft Scripting RunTime par VBA Outils Références cocher Microsoft Scripting RunTime
      '
      Static FSO As FileSystemObject
      Static bNotFirstTime As Boolean
      Static tabType As Variant, vType As Variant
      Static dicoType As Object
      Static strResult As String
      Dim bTheFirst As Boolean
      Dim oSourceFolder As Scripting.Folder
      Dim oSubFolder As Scripting.Folder
      Dim oFile As Scripting.File
      'Static wksDest As Worksheet
      'Static iRow As Long
      'initialisation
      bTheFirst = False
        If Not bNotFirstTime Then
        'On identifie le tout premiere appel de la fonction recursive
        bTheFirst = True
            Set FSO = CreateObject("Scripting.FileSystemObject")
        Set dicoType = CreateObject("Scripting.Dictionary")
        If strTypeFichier <> "" Then
            'On cré un tableau contenant toutes les extensions / * si rien de precisé
            tabType = Split(strTypeFichier, ";")
            ' a l'aide de ce tableau on renseigne notre dictionnaire
            For Each vType In tabType
                dicoType.Add vType, "Ext"
            Next
        End If
        bNotFirstTime = True
            On Error Resume Next
        Set oSourceFolder = FSO.GetFolder(strFolderName)
        On Error GoTo 0
            'On regarde si le rep existe bien
        If oSourceFolder Is Nothing Then
          MsgBox "Le répertoir '" & strFolderName & "' n'existe pas." & vbCrLf & "L'execution va prendre fin.", vbExclamation, "Répertoir inconnu"
          GoTo finApp
        End If
        End If
        Set oSourceFolder = FSO.GetFolder(strFolderName)
        'On boucle sur tous les fichier present
      For Each oFile In oSourceFolder.Files
        'On verifie que l'extension du fichier correspond a ce qui est demandé
        If dicoType.Exists(ExtractFileExt(oFile.Name)) Or (strTypeFichier = "") Then
            'On le rajoute dans la chaine result
            strResult = strResult & oFile.Path & ";"
        End If
      Next oFile
        'Si on a l'option Sous dossier on boucle sur les sous dossiers
      If bIncludeSubfolders Then
        For Each oSubFolder In oSourceFolder.SubFolders
        'On ajoute les fichiers contenu dans ce rep dans la liste precedente
          strResult = Join(ListFilesInFolder(oSubFolder.Path, True), ";") & ";"
        Next oSubFolder
      End If
       'On supprime le dernier ";" s'il il existe
      If Right(strResult, 1) = ";" Then strResult = Left(strResult, Len(strResult) - 1)
       'On renvoi le resulta sous forme de tabelau
      ListFilesInFolder = Split(strResult, ";")
    finApp:
      'Si on se trouve dans le 1er appel on reinitialise les vaiables Static
      'pour ne pas conserver des valeurs static lors d'une prochaine utilisation de la fonction
      If bTheFirst Then
        Set FSO = Nothing
        Set dicoType = Nothing
        bNotFirstTime = False
        tabType = ""
        vType = ""
        strResult = ""
      End If
    End Function
    Function ExtractFileExt(strName As String) As String
        If InStr(strName, ".") = 0 Then
            ExtractFileExt = ""
        Else
            ExtractFileExt = Mid(strName, InStrRev(strName, ".") + 1)
        End If
    End Function
    '...................................................................................................................................

  4. #4
    Candidat au Club
    Profil pro
    Inscrit en
    Juillet 2011
    Messages
    2
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juillet 2011
    Messages : 2
    Par défaut
    Bonjour,

    Merci à vous, je regarde ce que ça donne mais la solution de Vadorblanc me semble plus qu'acceptable

Discussions similaires

  1. [XL-2010] Erreur 1004 Fichier introuvable
    Par Crysta17 dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 07/04/2014, 12h02
  2. erreur 53 "Fichier introuvable"
    Par AndréPe dans le forum VBA Access
    Réponses: 4
    Dernier message: 17/02/2008, 18h35
  3. Réponses: 5
    Dernier message: 22/05/2007, 22h34
  4. [Erreur] E1026 Fichier introuvable : 'xxx.dfm'
    Par richard038 dans le forum Langage
    Réponses: 4
    Dernier message: 18/01/2006, 14h47
  5. [Debutant][Install][VS]erreur sur fichier non trouvé.
    Par silvermoon dans le forum DirectX
    Réponses: 4
    Dernier message: 16/07/2004, 20h59

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo