XL 2010 VBA Macro Chemin + boucle +récupère NomFichier

[jlbcall]

Bonjour à toutes et à tous,
J'ai une macro(voir ci dessous) qui doit importer des fichiers situés dans un répertoire nommé "UO"
Lorsque mes fichiers se trouvent sur mon bureau la macro fonctionnement parfaitement bien.
Par contre lorsque je veux la copier sur une autre racine (D:\ ou un serveur Z:\) elle ne fonctionne plus .
Elle trouve le fichier à ouvrir mais j'ai le message suivant, alors que je mets bien le bon chemin.
Exemple:
ChDir "Z:\Meth\Chiffr\UO"
NomFichier = Dir("Z:\Meth\Chiffr\UO\*.xlsx")

Attention une boucle doit récupérer le nom du fichier + passer ensuite au prochain et donc les ligne de la macro ci dessous sont importantes
=> Range("A" & DernLigne & ":A" & ActiveSheet.UsedRange.Rows.Count) = NomFichier
=> NomFichier = Dir permet de passé au fichier suivant
+


Merci d'avance pour votre aide bonne journée.


Sub Import_UO()
'Etape 01 Importer les données des fichiers UO exportés d'Hastus Liste PRAA
'Attention il est important que le nom des fichiers soient nommés par la codification
Dim NomFichier As String
Dim TtesLignes As Integer
Dim DernLigne As Integer
Cells.Select
Selection.Clear
Range("a1").Select
Range("A1") = "Imports des Habillages"

ChDir "C:\Users\jlb\Desktop\Chiffr\UO"
NomFichier = Dir("C:\Users\jlb\Desktop\Chiffr\UO\*.xlsx")
Workbooks.Open NomFichier ' il trouve le nom d'un fichier mais le message d'erreur
apparaît
Range("A1:AK1").Copy 'reprendre les entêtes de colonnes d'un des fchier UO
Workbooks("Valorisation_UO.xlsm").Activate
Range("b1").Select
ActiveSheet.Paste

While Len(NomFichier) > 0
Application.DisplayAlerts = False
Workbooks.Open NomFichier
TtesLignes = ActiveSheet.UsedRange.Rows.Count
Range("A2:AK" & TtesLignes).Copy
Workbooks("Valorisation_UO.xlsm").Activate
DernLigne = ActiveSheet.UsedRange.Rows.Count + 1
Range("B" & DernLigne).Select
ActiveSheet.Paste 'On colle les données
Range("A" & DernLigne & ":A" & ActiveSheet.UsedRange.Rows.Count) = NomFichier
Workbooks(NomFichier).Close
NomFichier = Dir
Wend

Columns("a:a").Replace ".xlsx"
Range("a1").Select
MsgBox "L'import a été effectué création du calendier sur l'onglet Cal suivre procédure"

End Sub

 

[2passage]

Bonjour,

Je pense qu'il manque un ChDrive. Un extrait de l'aide sur ChDir :
Si le lecteur par défaut est C, lecteur par défaut reste C, même si le dossier par défaut les modifications dans un dossier sur le lecteur d

 

[Compte Supprimé 979]

Salut jlbcall

Perso, jamais de ChBidule, j'utilise la fonction pour choisir le dossier d'import

Function ChoixDossier(DefautPath As String, sTitre As String)
  Dim fd As FileDialog
  Set fd = Application.FileDialog(msoFileDialogFolderPicker)
  With fd
    .Title = sTitre
    .InitialFileName = DefautPath
    If .Show = -1 Then
      ChoixDossier = fd.SelectedItems(1)
    End If
  End With
  Set fd = Nothing
End Function

Ce qui ferai dans ton code

Sub Import_UO()
'Etape 01 Importer les données des fichiers UO exportés d'Hastus Liste PRAA
'Attention il est important que le nom des fichiers soient nommés par la codification
Dim Chemin As String
Dim NomFichier As String
Dim TtesLignes As Integer
Dim DernLigne As Integer
Cells.Select
Selection.Clear
Range("a1").Select
Range("A1") = "Imports des Habillages"

Chemin = ChoixDossier(ThisWorkbook.Path, "Choix du dossier d'import")
NomFichier = Dir(Chemin & "\*.xlsx")

' Etc...

A+

 

[Dranreb]

Bonjour.
C'est soit :

NomFichier = Dir("Z:\Meth\Chiffr\UO\*.xlsx")
While NomFichier <> ""
   …
   Workbooks.Open "Z:\Meth\Chiffr\UO\" & NomFichier
   …
   NomFichier = Dir
   Wend

Soit :

ChDrive "Z": ChDir "Z:\Meth\Chiffr\UO"
NomFichier = Dir("*.xlsx")
While NomFichier <> ""
   …
   Workbooks.Open NomFichier
   …
   NomFichier = Dir
   Wend

Comme dit 2passage ChDir "Z:\Meth\Chiffr\UO" change le dossier courant sur le lecteur "Z", qui peut ne pas être le lecteur courant, mais ne change pas ce dernier. C'est ChDrive qui fait ça.

 

[MJ13]

Bonjour à tous

En général pour ce genre de problème, j'utilise un code de ce type. A adapter, bien sûr.

Sub Dir_Open_xls()
'Creer un dossier C:\Temp. Copier 4 fichier xls dans C:\Temp
'Sur une feuille excel, en A1, taper C:\Temp
'puis lancer la macro (Alt+F8) en étant en A1.
  N = 1
  NFAct = ActiveSheet.Name
  Dossier = Cells(1, 1)
  NF = Dir(Cells(1, 1) & "\*.xls*")
  Do While NF <> ""
  Workbooks(ThisWorkbook.Name).Sheets(NFAct).Cells(N, 3) = NF
  Workbooks.Open Filename:=(Dossier & "\" & NF)
  NF = Dir  ' suivant
  'Arrêt après 2 fichiers d'ouverts pour éviter que cela soit trop long
  N = N + 1
  If N = 3 Then End
  Loop
  ActiveCell.Offset(0, 1) = N
End Sub