Microsoft 365 Couper Coller Fichiers en VBA

Derrdio

XLDnaute Nouveau
Bonjour à tous,

Avec Chatgpt, j'ai un code qui me permet de couper des fichiers Word et txt d'un dossier A et de les coller dans un dossier B. J'ai très souvent une erreur à la ligne "DossierSource & Fichier As DossierDestination & Fichier". Est-ce que vous savez d'où cela peut venir et est-ce qu'il existe une solution ?

Le code en question :

VB:
Sub cctest1()

    Dim DossierSource As String
    Dim DossierDestination As String
    Dim Fichier As String

    ' Spécifiez le dossier source directement ici
    DossierSource = "C:\Users\PXC610\OneDrive - SUEZ\Bon réception Fameck Teams\" ' Modifiez cela avec votre chemin d'accès source

    ' Spécifiez le dossier destination directement ici
    DossierDestination = "C:\Users\PXC610\OneDrive - SUEZ\Bon réception Fameck Teams\Exploitation données\" ' Modifiez cela avec votre chemin d'accès destination

    ' Vérifier si les dossiers se terminent par un backslash (\)
    If Right(DossierSource, 1) <> "\" Then
        DossierSource = DossierSource & "\"
    End If

    If Right(DossierDestination, 1) <> "\" Then
        DossierDestination = DossierDestination & "\"
    End If

    ' Boucle à travers tous les fichiers Word (docx) dans le dossier source
    Fichier = Dir(DossierSource & "*.docx")
    Do While Fichier <> ""
        ' Couper/coller le fichier Word dans le dossier destination
        Name DossierSource & Fichier As DossierDestination & Fichier
        Fichier = Dir
    Loop

    ' Boucle à travers tous les fichiers texte (txt) dans le dossier source
    Fichier = Dir(DossierSource & "*.txt")
    Do While Fichier <> ""
        ' Couper/coller le fichier texte dans le dossier destination
        Name DossierSource & Fichier As DossierDestination & Fichier
        Fichier = Dir
    Loop

    MsgBox "Les fichiers ont été coupés/collés avec succès."

End Sub

Merci d'avance
 

fanch55

XLDnaute Barbatruc
Vous pouvez tester le code amélioré ci-dessous :
VB:
Option Explicit
Sub testmove()
    Dim DossierSource As String
    Dim DossierDestination As String
    Dim Fichier As String
    Dim Fso As Object, Ext As Variant

    ' Spécifiez les dossiers  directement ici
    DossierSource = "C:\Users\PXC610\OneDrive - SUEZ\Bon réception Fameck Teams\" ' Modifiez cela avec votre chemin d'accès source
    DossierDestination = "C:\Users\PXC610\OneDrive - SUEZ\Bon réception Fameck Teams\Exploitation données\" ' Modifiez cela avec votre chemin d'accès destination
  
    Set Fso = CreateObject("Scripting.FileSystemObject")
        If Fso.FolderExists(DossierSource) _
        And Fso.FolderExists(DossierDestination) Then
            On Error Resume Next ' Erreur Si pas de fichier avec l'extension
                For Each Ext In Array("*.docx", "*.txt")
                    Fso.DeleteFile DossierDestination & Ext
                    Fso.MoveFile DossierSource & Ext, DossierDestination
                Next
            On Error GoTo 0
            MsgBox "Les fichiers trouvés ont été coupés/collés avec succès."
        End If
    Set Fso = Nothing
   
End Sub
 

patricktoulon

XLDnaute Barbatruc
Bonjour
VB:
Sub cctest1()

    Dim DossierSource As String
    Dim DossierDestination As String
    Dim Fichier As String

    ' Spécifiez le dossier source directement ici
    DossierSource = "C:\Users\PXC610\OneDrive - SUEZ\Bon réception Fameck Teams\"    ' Modifiez cela avec votre chemin d'accès source

    ' Spécifiez le dossier destination directement ici
    DossierDestination = "C:\Users\PXC610\OneDrive - SUEZ\Bon réception Fameck Teams\Exploitation données\"    ' Modifiez cela avec votre chemin d'accès destination

    ' Vérifier si les dossiers se terminent par un backslash (\)
    If Right(DossierSource, 1) <> "\" Then
        DossierSource = DossierSource & "\"
    End If

    If Right(DossierDestination, 1) <> "\" Then
        DossierDestination = DossierDestination & "\"
    End If

    ' Boucle à travers tous les fichiers Word (docx) dans le dossier source
    Fichier = Dir(DossierSource & "*.docx")
    Do While Fichier <> ""
        If Fichier <> ThisWorkbook.Name Then
            Kill DossierDestination & Fichier
            DoEvents
            ' Couper/coller le fichier Word dans le dossier destination
            Name DossierSource & Fichier As DossierDestination & Fichier
        End If
        Fichier = Dir
    Loop
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 934
Messages
2 093 736
Membres
105 803
dernier inscrit
metroMBP