Problème ouverture fichiers multiples xml

Bonsoir,

Je viens vers vous pour un problème dont je ne vois aucune once de résolution...

J'utilise ce code:

Dim DernLigne As Long
Dim repertoiredePVàimporter As String
Dim wb As Workbook

repertoiredePVàimporter = ActiveWorkbook.Path & "\FICHIERS A TRAITER"

ChDir repertoiredePVàimporter

monfichier = Dir("PV*.xml")
While monfichier <> ""

Cells(Rows.Count, 1).End(xlUp)(2).Select

    Workbooks.OpenXML Filename:=monfichier

    If monfichier = False Then Exit Sub

   DernLigne = Range("BF" & Rows.Count).End(xlUp).Row
Range("AH3:AH" & DernLigne).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy

    Windows("gestion fichier.xlsm").Activate
    Cells(Rows.Count, 2).End(xlUp)(2).Select

    ActiveSheet.Paste

C'est une ouverture de tous les fichiers contenus dans le dossier FICHIER A TRAITER.

Ensuite le code fait des copier/coller de chaque fichier ouvert un à un sur le fichier gestion fichier.

Ce code fonctionne parfaitement bien lorsque je mets le dossier contenant le xlsm sur le bureau de mon PC.

Si je déplace ce dossier sous D ou une clé USB, il n'ouvre pas les xml...

Je n'arrive pas du tout à voir ce qui cloche...

Merci à vous de l'attention porté à mon projet.

Cordialement,

Innuendo67.

Bonjour,

Workbooks.OpenXML Filename:=ActiveWorkbook.Path & "\FICHIERS A TRAITER\" & monfichier

non ?

Et tu utilises ActiveWorkbook.Path, ce n'est pas ThisWorkbook.Path que tu veux plutôt ?

ActiveWorkbook = fichier actif

ThisWorkbook = celui qui a cette macro

eric

Bonsoir Eriiic.

Malheureusement cela ne fonctionne pas...

Mais le pire c'est que cela fonctionne parfaitement sur le bureau mais pas ailleurs... Etrange...

Cordialement,

Innuendo67

Bonsoir,

ChDir ne modifie que le répertoire courant, pas le lecteur. Si on doit passer de C: à D: il faut donc aussi changer de lecteur courant avec ChDrive.

Bonjour MFerrand,

ça ne fonctionne pas non plus...

Je mets l'intégralité du code pour que ce soit plus clair. Il est surement perfectible dans le fond...

Sub importgroupédePVxml()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Windows("gestion fichier.xlsm").Activate
Range("A2:K1000000").Select

    ActiveWindow.ScrollRow = 1
    Selection.ClearContents

Dim DernLigne As Long
Dim repertoiredePVàimporter As String
Dim wb As Workbook

repertoiredePVàimporter = ActiveWorkbook.Path & "\FICHIERS A TRAITER"

ChDir repertoiredePVàimporter

monfichier = Dir("PV*.xml")

While monfichier <> ""

Cells(Rows.Count, 1).End(xlUp)(2).Select

    Workbooks.OpenXML Filename:=monfichier

   If monfichier = False Then Exit Sub
   ''
   DernLigne = Range("BF" & Rows.Count).End(xlUp).Row
Range("AH3:AH" & DernLigne).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy

    Windows("gestion fichier.xlsm").Activate
    Cells(Rows.Count, 2).End(xlUp)(2).Select

    ActiveSheet.Paste

'Dim wb As Workbook
    For Each wb In Workbooks
        If UCase(wb.Name) Like "PV*" Then wb.Activate: Exit For
    Next wb

   ''
   DernLigne = Range("BF" & Rows.Count).End(xlUp).Row
Range("AH3:AH" & DernLigne).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
        ''

    Windows("gestion fichier.xlsm").Activate
    Cells(Rows.Count, 5).End(xlUp)(2).Select

    ActiveSheet.Paste

    For Each wb In Workbooks
        If UCase(wb.Name) Like "PV*" Then wb.Activate: Exit For
    Next wb

   DernLigne = Range("BF" & Rows.Count).End(xlUp).Row
Range("BF3:BF" & DernLigne).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
        ''

    Windows("gestion fichier.xlsm").Activate
    Cells(Rows.Count, 4).End(xlUp)(2).Select

    ActiveSheet.Paste

    For Each wb In Workbooks
        If UCase(wb.Name) Like "PV*" Then wb.Activate: Exit For
    Next wb
   ''
   DernLigne = Range("BF" & Rows.Count).End(xlUp).Row
Range("BV3:BV" & DernLigne).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
        ''

    Windows("gestion fichier.xlsm").Activate
    Cells(Rows.Count, 9).End(xlUp)(2).Select

    ActiveSheet.Paste

    For Each wb In Workbooks
        If UCase(wb.Name) Like "PV*" Then wb.Activate: Exit For
    Next wb
   ''
   DernLigne = Range("BF" & Rows.Count).End(xlUp).Row
Range("CD3:CD" & DernLigne).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
        ''

    Windows("gestion fichier.xlsm").Activate
    Cells(Rows.Count, 3).End(xlUp)(2).Select

    ActiveSheet.Paste

    For Each wb In Workbooks
        If UCase(wb.Name) Like "PV*" Then wb.Activate: Exit For
    Next wb
   ''
   DernLigne = Range("BF" & Rows.Count).End(xlUp).Row
Range("DI3:DI" & DernLigne).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
        ''

    Windows("gestion fichier.xlsm").Activate
    Cells(Rows.Count, 10).End(xlUp)(2).Select

    ActiveSheet.Paste

    For Each wb In Workbooks
        If UCase(wb.Name) Like "PV*" Then wb.Activate: Exit For
    Next wb
   ''
   DernLigne = Range("BF" & Rows.Count).End(xlUp).Row
Range("IW3:IW" & DernLigne).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
        ''

    Windows("gestion fichier.xlsm").Activate
    Cells(Rows.Count, 8).End(xlUp)(2).Select

    ActiveSheet.Paste

''
For Each wb In Workbooks
        If UCase(wb.Name) Like "PV*" Then wb.Activate: Exit For
    Next wb
   ''
   DernLigne = Range("BF" & Rows.Count).End(xlUp).Row
Range("EM3:EM" & DernLigne).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
        ''

 ActiveWindow.Close

    Windows("gestion fichier.xlsm").Activate
    Cells(Rows.Count, 11).End(xlUp)(2).Select

    ActiveSheet.Paste

monfichier = Dir()

Wend

Application.ScreenUpdating = True
Application.DisplayAlerts = True

Columns("F:G").Select
Selection.NumberFormat = "General"

'MsgBox "FIN DE TRAITEMENT"
Windows("gestion fichier.xlsm").Activate

Range("A1").Select

End Sub

Je rappelle que ce code fonctionne parfaitement bien dès que le dossier contenant le fichier gestion fichier est sur le bureau.

Sur D non, sur une clé USB non plus... il ne m'importe rien comme s'il n'ouvrait pas les fichiers xml du dossier FICHIERS A TRAITER...

Merci de votre attention.

Cordialement,

Innuendo67

Bonjour,

commence par enlever les caractères accentuées dans les noms de tes variables ...

ensuite il ne faut pas utiliser chDir mais préciser explicitement le répertoire dans toutes tes commandes Dir ou Open..

(...)
monfichier = Dir(repertoiredePVaimporter & "\PV*.xml")   ' Dir ne renvoi que le nom du fichier pas son chemin !!

While monfichier <> ""

Cells(Rows.Count, 1).End(xlUp)(2).Select

    Workbooks.OpenXML Filename:=repertoiredePVaimporter & "\" & monfichier
(....)

Bonjour Pierre.jy,

effectivement cela fonctionne sur D ou sur une clé USB. Mais.....cela ne fonctionne plus lorsque le dossier contenant le xlsm est sur le bureau. Je ne comprends vraiment pas pourquoi...

Cordialement,

Innuendo67

re,

et comment renseigne tu la variable :

repertoiredePVaimporter 

en particulier lorsque le fichier est sur ton bureau ?

Rechercher des sujets similaires à "probleme ouverture fichiers multiples xml"