Microsoft 365 Couper Coller Fichiers en VBA

[Derrdio]

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 :

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]

Bonjour,

Name, instruction (VBA)

Rubrique de référence sur Office VBA

learn.microsoft.com

Le fichier cible ne doit pas exister.
Le fichier source ne doit pas être ouvert.

 

[fanch55]

Vous pouvez tester le code amélioré ci-dessous :

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]

Bonjour

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