#1
|
|||
|
|||
Batch convert doc to docx
Hi to all.
I have over 2000 word files inside a folder and subfolders and i would like to change them from old DOC to DOCX. So I want to change all DOC files inside a folder AND it's subfolders to DOCX. If it's possible i would like also to have the option to delete the original DOC files after the conversion. Thanks in advanced for your time and help. |
#2
|
|||
|
|||
|
#3
|
||||
|
||||
Simply saving in the docx format will wipe out any VBA code the existing documents might contain (including for ActiveX controls). Try:
Code:
Option Explicit Dim FSO As Object, oFolder As Object, StrFolds As String Sub Main() Application.ScreenUpdating = False Dim TopLevelFolder As String, TheFolders As Variant, aFolder As Variant, i As Long TopLevelFolder = GetFolder StrFolds = vbCr & TopLevelFolder If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject") End If 'Get the sub-folder structure Set TheFolders = FSO.GetFolder(TopLevelFolder).SubFolders For Each aFolder In TheFolders RecurseWriteFolderName (aFolder) Next 'Process the documents in each folder For i = 1 To UBound(Split(StrFolds, vbCr)) Call UpdateDocuments(CStr(Split(StrFolds, vbCr)(i))) Next Application.ScreenUpdating = True End Sub Sub RecurseWriteFolderName(aFolder) Dim SubFolders As Variant, SubFolder As Variant Set SubFolders = FSO.GetFolder(aFolder).SubFolders StrFolds = StrFolds & vbCr & CStr(aFolder) On Error Resume Next For Each SubFolder In SubFolders RecurseWriteFolderName (SubFolder) Next End Sub Function GetFolder() As String Dim oFolder As Object GetFolder = "" Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0) If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path Set oFolder = Nothing End Function Sub UpdateDocuments(oFolder As String) Dim strFldr As String, strFile As String, wdDoc As Document strFldr = oFolder: If strFldr = "" Then Exit Sub strFile = Dir(strFldr & "\*.doc", vbNormal) While strFile <> "" If UBound(Split(strFile, ".doc")) = 0 Then Set wdDoc = Documents.Open(FileName:=strFldr & "\" & strFile, AddToRecentFiles:=False, ReadOnly:=False, Visible:=False) With wdDoc 'Save as docx or docm, depending on whether the file contains macros. If .HasVBProject = False Then .SaveAs2 FileName:=.FullName & "x", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False Else .SaveAs2 FileName:=.FullName & "m", FileFormat:=wdFormatXMLDocumentMacroEnabled, AddToRecentFiles:=False End If 'close the document .Close False End With 'Delete the old file Kill strFldr & "\" & strFile End If strFile = Dir() Wend Set wdDoc = Nothing End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Batch applying a macro to remove Header and Footer using Batch Auto Addin | Edszx | Word VBA | 2 | 05-27-2019 11:16 PM |
Batch instruction works or ".doc" in folder, but not ".docx" | raymondroe | Word VBA | 4 | 02-15-2015 01:19 AM |
Remove Compatibility Mode on DOCX files (batch) | w64bit | Word | 17 | 02-01-2015 06:02 AM |
Batch convert multiple 32 bit xslx to 32 bit docx | mapl | Excel | 2 | 06-14-2013 05:29 PM |
Convert error docx--> doc: You cannot put drawings into a text box, callout, comment, | pstein | Word | 5 | 07-29-2012 09:06 PM |