XL 2016 Code VBA ne trouve pas fichiers alors que bien présents

Aloha · 14 Janvier 2018

Bonjour,
Un code qui fonctionne depuis plus de 10 ans ne trouve tout d'un coup plus les fichiers qu'il doit ouvrir et copier.
J'ai préparé un exemple, enlevé tout ce qui n'est pas essentiel, j'ai essayé le code avec un fichier factice et le code le trouve, alors que l'architecture du tout est la même que dans la réalité.
Le bout de code responsable:

Code:

Pfad = ActiveWorkbook.Path
SuchPfad = Pfad & "\TobeCopied"
ChDir SuchPfad
'---check if there are files to be copied----
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
    MsgBox "No files in the Directory"
    ChDir Pfad
    Exit Sub
End If

Cela m'embête énormément.
Quelqu'un parmi vous aurait-il une idée à quoi cela pourrait tenir?
J'ai tout vérifié: le chemin est exact, les fichiers dans le dossier "ToBeCopied sont bien des fichiers ".xls", et le fichier contenant le code est aussi le bon.
Bonne journée
Aloha

Staple1600 · 14 Janvier 2018

Bonjour le fil, le forum

@Aloha
Il y a un message d'erreur affiché ou pas?

Je ne vois pas ton fichier Exemple
(et ton code VBA n'est pas complet)

EDITION: Bonjour chris

chris · 14 Janvier 2018

Bonjour

Déjà il semble manquer "\" à la fin du chemin
Est-ce toujours xls et non xlsx ? (il serait temps "d'oublier" le xls remplacé depuis 10 ans)

Edit Coucou Staple

Staple1600 · 14 Janvier 2018

Re

Alors replongeons 10 ans en arrière
(au moins on a tout le code désormais)
https://www.excel-downloads.com/threads/problème-vba.221708/

NB: Il y avait déjà un problème à cette époque, Aloha

Sinon, il y a beaucoup plus court comme code pour faire ce que tu veux
(à la lecture du code de fil de 2007)

Aloha · 14 Janvier 2018

Bonjour,
Merci pour vos réponses.
Ce sont bien des fichiers ".xls" et le chemin est le bon et je reçois le message d'erreur défini pasr le code, donc pas un message d'erreur Excel.
Je n'ai pas joint l'exemple parce qu'il fonctionne, Dieu sait pourquoi!
Si j'ajoute un "\" cela ne change rien et ça a toujours fonctionné comme ça.

A votre demande j'ai réouvert le fichier exemple, et là ça ne fonctionne polus non plus. Je le joins donc.
L'hiérarchie de l'emplacement:
Dans un dossier nommé p.ex. "Test" il y a le fichier "Base.xlsm" contenant la macro et le dossier "ToBeCopied" contenant le fichier .xls. à ouvrir. Dans la réalité il y en a 10 à la fois.
Dans la fenêtre du code j'ai laissé deux modules avec des fonctions dans lesquelles je vois des fois sauter le code (F8).
Auriez-vous une idée à quoi cela pourrait tenir? Mais c'est un problème subordonné.
Bien à vous
Aloha

Aloha · 14 Janvier 2018

Re,
@JM: ta "mémoire" est bonne oui et non: en effet j'avais déjà ce problème dans le passé et je ne me rappelle pas comment il s'est résolu, mais ce n'était pas 10 ans en arrière mais en 2014.
Comment pourrais-je te contredire si tu affirmes qu'il y a plus court? Ce n'est pas moi qui ai créé ce code et de moi-même je ne suis pas capable de l'améliorer. Cependant, je suis ouvert à toute proposition!
A+
Aloha

Staple1600 · 14 Janvier 2018

Re

Voici un petit exemple
Est-ce chez toi, ce code affiche bien le nom des fichiers Excel présents dans le dossier choisi

VB:

Sub Test_Aloha()
Dim FSO As Object
Dim oFile
Dim oFolder
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim sFolderName$, oFldialog As FileDialog
Set oFldialog = Application.FileDialog(msoFileDialogFolderPicker)
With oFldialog
    If .Show = -1 Then
    .Title = "Sélectionner le dossier source"
    .AllowMultiSelect = False
    sFolderName = .SelectedItems(1)
    Else
    Exit Sub
    End If
End With
Set oFolder = FSO.GetFolder(sFolderName)
For Each oFile In oFolder.Files
If oFile.Name Like "*.xl*" Then
'ici juste pour test
MsgBox oFile.Name
End If
Next
End Sub

Staple1600 · 14 Janvier 2018

Re

@Aloha
Quelles sont exactement les adresses des cellules à recopier?
(ton fichier Classeur1.xls est quasi-vide , une seule valeur en A1...)

Aloha · 14 Janvier 2018

Re,
à cette ligne de code:

Code:

sFolderName = .SelectedItems(1)

s'ouvre la fenêtre pour ouvrir un fichier.

J'ai effacé les autres adresses puisque le code n'arrive pas jusque-là.
Avec toutes les adresses le problème est le même. En réalité il y en a 66.

A+
Aloha

Staple1600 · 14 Janvier 2018

Re

Non il faut choisir un dossier contenant des fichiers Excel
(Il ne faut pas sélectionner un fichier Excel)

On est dans la réalité, non ?
J'ai donc besoin des adresses des 66 cellules pour te proposer un code fonctionnel
(sauf si tu n'est pas intéressé par un nouveau code)

Staple1600 · 14 Janvier 2018

Re

@Aloha
Suite de mes tests
La macro ci-dessous fonctionne
(NB: C'est juste une macro de démonstration, il faudra l'adapter à ta situation réelle)
Mode opératoire:
1) La macro me demande de sélectionner un dossier
2) Je seléctionne donc le dossier contenant les classeurs dont je dois recopier certaines cellules (ici A1:A10) de toutes les feuilles de tous les classeurs.

VB:

Sub Test_Aloha_II()
Dim FSO As Object, WorkBk As Workbook, wDs As Worksheet, ws As Worksheet, t
Dim oFile
Dim oFolder
Set FSO = CreateObject("Scripting.FileSystemObject")
Set wDs = ThisWorkbook.Sheets("Database")
Dim sFolderName$, oFldialog As FileDialog
Set oFldialog = Application.FileDialog(msoFileDialogFolderPicker)
With oFldialog
    If .Show = -1 Then
    .Title = "Sélectionner le dossier source"
    .AllowMultiSelect = False
    sFolderName = .SelectedItems(1)
    Else
    Exit Sub
    End If
End With
Application.ScreenUpdating = False
Set oFolder = FSO.GetFolder(sFolderName)
For Each oFile In oFolder.Files
    If oFile.Name Like "*.xl*" Then
    Set WorkBk = Workbooks.Open(oFile)
        For Each ws In WorkBk.Worksheets
        t = ws.Range("A1:A10").Value
        wDs.Cells(Rows.Count, 1).End(xlUp)(2).Resize(, UBound(t)) = Application.Transpose(t)
        Next
    Erase t
    WorkBk.Close False
    End If
Next
End Sub

Aloha · 14 Janvier 2018

Re,
Réponse au message #10:

Staple1600 à dit:
Non il faut choisir un dossier contenant des fichiers Excel

Je n'avais pas compris cela. N'est-ce pas anormal qu'il montre un chemin qui n'est pas le bon? Lorsque je choisis le bon dossier "ToBeCopied" le classeur est trouvé!

Staple1600 à dit:
J'ai donc besoin des adresses des 66 cellules

Je ne comprends pas cela, mais c'est toi l'expert en la matière, pas moi.
Voici les deux fichiers revisités: dans l'un le code complet et dans l'autre des chiffres dans les cellules qui doivent être copiées.
Tu ne manqueras sûrement de constater que la cellule AY67 est copiée 4 fois. La raison: avec les modifications dans la réglementation les données concernées ne sont plus relevées et il me semblait que, avec mes moyens, la meilleure solution était de ne pas toucher à la structure, mais de copier des cellules à présent vides.
A+
Aloha

UPDATE: ok, je comprends maintenant pourquoi tu as besoin du code entier

Aloha · 14 Janvier 2018

Re,

Réponse au message #11:

Je l'ai testé. J'ai mis des valeurs dans A1:A10, mais elle ne sont pas collées dans la Database.

D'ailleurs, lorsque je dois choisir un fichier et que je ne fais pas que sélectionner le dossier "ToBeCopied", mais que je l'ouvre, le fichier n'est pas montré Est-ce normal où est-ce le même problème que lcelui qui m'a amené à démarrer ce sujet?

A+
Aloha

Staple1600 · 14 Janvier 2018

Re

As-tu essayé ma dernière macro?
(qui je le rappelle est une macro de test)
Pour la tester:
1) Tu créés 3 classeurs (avec chacun 3 feuilles) dans un dossier que tu nommes par exemple toto
Dans le classeur qui contient la feuille Database , tu mets puis lance la macro.
Voila ce que j'obtient sur mon PC

On vient que j'ai bien récupéré les valeurs A1:A10 de chaque feuille des trois classeurs dans la feuille Database.

Sinon dans ton fichier Base, il n'y a que 64 valeurs pas 66.

Aloha · 14 Janvier 2018

Re,
J'ai fait suivant tes instructions et le code fonctionne!
Seulement, je ne sais pas comment intégrer cette multitude de Vardata.
A+
Aloha

XL 2016 Code VBA ne trouve pas fichiers alors que bien présents

Aloha

XLDnaute Accro

Staple1600

XLDnaute Barbatruc

chris

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Aloha

XLDnaute Accro

Pièces jointes

Aloha

XLDnaute Accro

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Aloha

XLDnaute Accro

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Aloha

XLDnaute Accro

Pièces jointes

Aloha

XLDnaute Accro

Staple1600

XLDnaute Barbatruc

Pièces jointes

Aloha

XLDnaute Accro

Discussions similaires