Mi è capitato di avere un sacco di documenti word che volevo convertire in file di testo automaticamente e non sapevo come fare.
Ho risolto con questa macro VB che una volta lanciata chiede la cartella di partenza e poi la cartella di destinazione, convertendo tutti i file word che trova nella cartella iniziale.
Ecco il codice:
Option Explicit
Sub BatchDocxToTxt()
Dim srcFolder As String, destRoot As String
Dim fldrPicker As FileDialog
' Seleziona cartella sorgente
Set fldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With fldrPicker
.Title = "Seleziona la cartella sorgente (verranno cercati *.docx ricorsivamente)"
If .Show <> -1 Then Exit Sub
srcFolder = .SelectedItems(1)
End With
' Seleziona cartella destinazione
Set fldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With fldrPicker
.Title = "Seleziona la cartella destinazione (qui verranno salvati i .txt)"
If .Show <> -1 Then Exit Sub
destRoot = .SelectedItems(1)
End With
If Right(srcFolder, 1) <> "\" Then srcFolder = srcFolder & "\"
If Right(destRoot, 1) <> "\" Then destRoot = destRoot & "\"
Application.ScreenUpdating = False
Application.DisplayAlerts = wdAlertsNone
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
On Error GoTo CleanUp
ProcessFolderRecursive fso.GetFolder(srcFolder), srcFolder, destRoot, fso
MsgBox "Conversione completata.", vbInformation
CleanUp:
Application.ScreenUpdating = True
Application.DisplayAlerts = wdAlertsAll
Set fso = Nothing
End Sub
Private Sub ProcessFolderRecursive(ByVal folder As Object, ByVal srcRoot As String, ByVal destRoot As String, ByVal fso As Object)
Dim fileItem As Object
Dim subFld As Object
Dim relPath As String
Dim targetFolder As String
Dim doc As Document
Dim srcPath As String
Dim baseName As String
Dim targetPath As String
' Processa i file .docx nella cartella corrente
For Each fileItem In folder.Files
If LCase(fso.GetExtensionName(fileItem.Name)) = "docx" Then
' skip temporary Word files (es. ~$_...)
If Left(fileItem.Name, 2) <> "~$" Then
srcPath = fileItem.Path
' Calcola percorso relativo della cartella contenente il file rispetto alla radice sorgente
relPath = Replace(folder.Path, srcRoot, "")
If Left(relPath, 1) = "\" Then relPath = Mid(relPath, 2)
' Crea cartella corrispondente nella destinazione (se serve)
If relPath = "" Then
targetFolder = destRoot
Else
' targetFolder = fso.BuildPath(destRoot, relPath)
End If
' Nome base e percorso di destinazione
baseName = fso.GetBaseName(fileItem.Name)
targetPath = fso.BuildPath(destRoot, baseName & ".txt")
' Apri il documento e salva come testo Unicode (per preservare accenti/utf8)
On Error Resume Next
Set doc = Documents.Open(FileName:=srcPath, ReadOnly:=True, AddToRecentFiles:=False)
If Err.Number <> 0 Then
Debug.Print "Errore aprendo: " & srcPath & " -> " & Err.Description
Err.Clear
On Error GoTo 0
Else
On Error GoTo 0
' wdFormatUnicodeText preserva Unicode; se vuoi ANSI usa wdFormatText (ma perde caratteri non ANSI)
doc.SaveAs2 FileName:=targetPath, FileFormat:=wdFormatUnicodeText
doc.Close SaveChanges:=False
Set doc = Nothing
End If
End If
End If
Next fileItem
' Ricorsione nelle sottocartelle
For Each subFld In folder.SubFolders
ProcessFolderRecursive subFld, srcRoot, destRoot, fso
Next subFld
End Sub