Eliminar archivos duplicados de word en windows 10

Te anexo 2 macros que deberás ejecutar desde un archivo de excel.

La primera macro es para listar en una hoja de excel todos los archivos de la carpeta y subcarpetas.

Abre un archivo de excel nuevo y pon la siguiente macro:

Solamente cambia en la macro esto:

"C:\trabajo\archivos"

Por el nombre de la carpeta inicial donde tienes los archivos, la macro se va a encargar de leer las carpetas, subcarpetas y los archivos word que ahí se encuentran.

Dim rutas As New Collection
'
Sub Listar_Archivos()
'
'   Por.Dante Amor
'
'   Revisa los archivos de una carpeta y subcarpetas
'   obtienes los atributos fecha y hora
'   y elimina los duplicados
    '
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ruta = "C:\trabajo\archivos"        'carpeta inicial
    ext = "doc*"                        'extensión documentos
    '
    Set h1 = Sheets(1)                  'hoja para revisar los archivos
    h1.Columns("A:F").ClearContents
    h1.Range("A1:F1").Value = Array("Carpeta", "Archivo", "archivo y fecha", "Tamaño", "Estatus", "Estatus final")
    '
    Set atributos = CreateObject("Scripting.FileSystemObject")
    rutas.Add ruta
    Call AgregaDir(ruta)
    fila = 2
    For Each sd In rutas
        arch = Dir(sd & "\*." & ext)
        Do While arch <> ""
            h1.Cells(fila, "A").Value = sd
            h1.Cells(fila, "B").Value = arch
            h1.Cells(fila, "C").Value = arch & " " & atributos.GetFile(sd & "\" & arch).DateLastModified
            h1.Cells(fila, "D").Value = atributos.GetFile(sd & "\" & arch).Size
            fila = fila + 1
            arch = Dir()
        Loop
    Next
    u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
    With h1.Range("E2:E" & u1)
        .FormulaR1C1 = "=IF(COUNTIF(RC[-2]:R" & u1 & "C2,RC[-2])>1,""Eliminar"",""Se queda"")"
        .Value = .Value
    End With
    With h1.Sort
        .SortFields.Clear
        .SortFields.Add Key:=h1.Range("B2:B" & u1), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange h1.Range("A2:E" & u1)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    h1.Columns("A:F").EntireColumn.AutoFit
    '
    Set rutas = Nothing
    Application.ScreenUpdating = True
    MsgBox "Depurar archivos", vbInformation, "ARCHIVOS"
End Sub
'
Sub AgregaDir(lpath) 'Agrega directorios
'Por.Dante Amor
    Dim SubDir As New Collection
    If Right(lpath, 1) <> "\" Then lpath = lpath & "\"
    DirFile = Dir(lpath & "*", vbDirectory)
    Do While DirFile <> "" 'Agrega subdirectorios a collection
        If DirFile <> "." And DirFile <> ".." Then _
            If ((GetAttr(lpath & DirFile) And vbDirectory) = 16) Then _
                SubDir.Add lpath & DirFile
        DirFile = Dir
    Loop
    For Each sd In SubDir
        rutas.Add sd
        Call AgregaDir(sd)
    Next
End Sub

Sigue las Instrucciones para un botón y ejecutar la macro

1. Abre tu libro de Excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
3. En el menú elige Insertar / Módulo
4. En el panel del lado derecho copia la macro
5. Ahora para crear un botón, puedes hacer lo siguiente:
6. Inserta una imagen en tu libro, elige del menú Insertar / Imagen / Autoformas
7. Elige una imagen y con el Mouse, dentro de tu hoja, presiona click y arrastra el Mouse para hacer grande la imagen.
8. Una vez que insertaste la imagen en tu hoja, dale click derecho dentro de la imagen y selecciona: Tamaño y Propiedades. En la ventana que se abre selecciona la pestaña: Propiedades. Desmarca la opción “Imprimir Objeto”. Presiona “Cerrar”
9. Vuelve a presionar click derecho dentro de la imagen y ahora selecciona: Asignar macro. Selecciona: Listar_Archivos
10. Aceptar.
11. Para ejecutarla dale click a la imagen.

Al finalizar la macro, en la hoja aparecerán las carpetas, los nombres de los archivos y en la columna E el texto "Eliminar" para los archivos que serán eliminados.

Revisa los archivos que serán eliminados, si estás de acuerdo, ejecuta la segunda macro para eliminar los archivos.

Sub Eliminar_Archivos_Duplicados()
'Por Dante Amor
    On Error Resume Next
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        ruta = Cells(i, "A").Value
        arch = Cells(i, "B").Value
        If Cells(i, "E").Value = "Eliminar" Then
            If Dir(ruta & "\" & arch) <> "" Then
                Kill ruta & "\" & arch
                werr = Err.Number
                wdes = Err.Description
                If werr = 0 Then
                    Cells(i, "F").Value = "Eliminado"
                Else
                    If Dir(ruta & "\" & arch) = "" Then
                        Cells(i, "F").Value = "Eliminado"
                    Else
                        Cells(i, "F").Value = "Error : " & werr & " " & Err.Description
                    End If
                End If
            End If
        End If
    Next
    MsgBox "Archivos Eliminados"
End Sub

Sigue las mismas instrucciones para poner un botón y ejecutar la macro, solamente en:

Asignar macro. Selecciona: Eliminar_Archivos_Duplicados

Después de ejecutar la segunda macro, en la columna F aparecerá el texto "Eliminado".

'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. 

Hola Dante, buen día! Muchas gracias por Tu ayuda y aquí solicitando Tu apoyo... estoy haciendo el pegado de las macros y cambiando únicamente la dirección de dónde se encuentra la carpeta que es: C:\Users\*****\Desktop\repeticion de archivos en ésta carpeta de: repetición de archivos está la carpeta dónde tiene otras subcarpetas y ahí los archivos, revisando, unos tienen extensión .doc y otros .docx, podrías guiarme por favor en qué parte poner la otra extensión.. gracias nuevamente y estar aquí al pendiente del problema.