Macro to Convert Word 2007 to Word 2003

[Rudi]

Hi,

I am needing help to complete this Word Macro to convert word files from 2007 to 2003.

The basic setup is working well, but a few tweaks are needed:

1. I dunno how to save in 2003 format? The argument in the SaveFormat method is changed to wdFormatDocument97, but it still saves as 2007.
2. Other requests to follow :)

Here is the macro:

Code: Select all

  Dim myFile As String
  Dim strOldPath As String
  Dim strNewPath As String
'  Dim i As Long
'  Dim n As Long
  strOldPath = "D:\Test\W2007\"
  strNewPath = "D:\Test\W2003\"

  ' Loop to get file count
  myFile = Dir(strOldPath & "*.doc*")
'  Do Until myFile = ""
'    n = n + 1
'    myFile = Dir
'  Loop
  
    Do Until myFile = ""
'    i = i + 1
        ChangeFileOpenDirectory strOldPath
        Documents.Open FileName:=myFile, ConfirmConversions:=False, _
             ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
            PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
            WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""
        ChangeFileOpenDirectory strNewPath
        ActiveDocument.SaveAs FileName:=myFile, FileFormat:= _
            wdFormatDocument97, LockComments:=False, Password:="", AddToRecentFiles:= _
            True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
            False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
            SaveAsAOCELetter:=False
        ActiveDocument.Close
        myFile = Dir
    Loop
End Sub

[HansV]

You'll have to remove the last character of the extension (.docx or .docm) so that the new filename has extension .doc.

Try

Code: Select all

Sub ConvertTo2003()
  Dim myFile As String
  Dim strOldPath As String
  Dim strNewPath As String
  Dim doc As Document
  Dim i As Long
  Dim n As Long
  strOldPath = "D:\Test\W2007\"
  strNewPath = "D:\Test\W2003\"

  Application.ScreenUpdating = False

  ' Loop to get file count
  myFile = Dir(strOldPath & "*.doc*")
  Do Until myFile = ""
    n = n + 1
    myFile = Dir
  Loop
  
  myFile = Dir(strOldPath & "*.doc?")
  Do Until myFile = ""
    i = i + 1
    Application.StatusBar = "Processing document " & i & " of " & n
    Set doc = Documents.Open(FileName:=strOldPath & myFile, _
      ConfirmConversions:=False, AddToRecentFiles:=False)
    doc.SaveAs FileName:=strNewPath & Left(myFile, Len(myFile) - 1), _
      FileFormat:=wdFormatDocument97, AddToRecentFiles:=False
    doc.Close SaveChanges:=False
    myFile = Dir
  Loop

  Application.StatusBar = ""
  Application.ScreenUpdating = True
End Sub

Note that I don't use ChangeFileOpenDirectory; I specify the path explicitly in the Open and SaveAs instructions.

[Rudi]

Tx for reply Hans,

I have a runtime error as you can see in the attached... Any ideas?

[HansV]

Sorry, it was air code. It should have been

doc.SaveAs FileName:=strNewPath & Left(myFile, Len(myFile) - 1), _

[Rudi]

Working great now!

You deserve a really cold beer!

TX for your help today!

[HansV]

It's bit early in the day for that, but thank you!