Solved

VBA to re-save all files in a directory (document conversion to office 2010)

Posted on 2012-03-16
5
1,095 Views
Last Modified: 2012-04-17
I am trying to do a mass conversion of our Word and Excel documents from the 2003 format to the office 2010 file formats.  There are about 3500 docs that I am looking to convert.

I have managed to create this macro which converts Word docs fairly quickly on a 1-by-1 basis without the extra prompts, but I would love to expand the code to do it for entire directories at a time (even better if it would do it recursively for subfolders).

I am not as familiar with VBA as vbscript and am having a hard time doing this.  Can anyone help?

OriginalFileName = ActiveDocument.Name
Path = ActiveDocument.Path
NewFileName = OriginalFileName & "x"
ChangeFileOpenDirectory Path
ActiveDocument.SaveAs2 FileName:=NewFileName, FileFormat:= _
    wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
    :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
    :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
    SaveAsAOCELetter:=False, CompatibilityMode:=14
        
ActiveDocument.Close
WholePath = Path & "\" & OriginalFileName
Kill WholePath

Open in new window

I have played with the Microsoft OMPM converter utility, but although this seems to convert doc's and xls's to docx's and xlsx's, it seems to put them into 2007 version.  When you open them in 2010 it still says "Compatibility Mode" at the top.  So this is not a good solution for me.

Thanks!
0
Comment
Question by:lou6150
5 Comments
 
LVL 23

Assisted Solution

by:JSRWilson
JSRWilson earned 250 total points
ID: 37732090
Can you not use the File Scripting Object?

Here's the basic code which you can add your open / resave code too

Sub get_all()
Dim fso As Object
Dim folder As Object
Dim subfolder As Object
Dim file As Object
Dim directory As String

directory = "C:\Users\John\Desktop\Test\" ' change of course

Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(directory)
For Each file In folder.Files
MsgBox file.Name ' open save here
Next file
For Each subfolder In folder.SubFolders
For Each file In subfolder.Files
MsgBox file.Name 'open save here
Next file
Next subfolder
End Sub

Open in new window

0
 
LVL 92

Accepted Solution

by:
Patrick Matthews earned 250 total points
ID: 37733890
This appears to be working.  It will recursively drill into all the subfolders it finds.

It looks for all files in the starting folder plus descendant folders with the following extensions:

xls
xlt
xla
doc
dot

It converts each to its macro-enabled equivalent to ensure no problems with VBA getting chopped out.

Make a back-up of your stuff before using this!


Dim Result
Dim xlApp, wdApp, xlWb, wdDoc
Dim Counter, OldName, NewName
Dim fso

GetFiles "c:\Test" 'change as needed

If IsArray(Result) Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set xlApp = CreateObject("Excel.Application")
    Set wdApp = CreateObject("Word.Application")
    For Counter = 0 To UBound(Result)
        OldName = Result(Counter)
        Select Case LCase(Right(OldName, 4))
            Case ".xls"
                Set xlWb = xlApp.Workbooks.Open(OldName)
                NewName = Left(OldName, InStrRev(OldName, ".")) & "xlsm"
                xlWb.SaveAs NewName, 52
                xlWb.Close
            Case ".xlt"
                Set xlWb = xlApp.Workbooks.Open(OldName)
                NewName = Left(OldName, InStrRev(OldName, ".")) & "xltm"
                xlWb.SaveAs NewName, 53
                xlWb.Close
            Case ".xla"
                Set xlWb = xlApp.Workbooks.Open(OldName)
                NewName = Left(OldName, InStrRev(OldName, ".")) & "xlam"
                xlWb.SaveAs NewName, 55
                xlWb.Close
            Case ".doc"
                Set wdDoc = wdApp.Documents.Open(OldName)
                NewName = Left(OldName, InStrRev(OldName, ".")) & "docm"
                wdDoc.SaveAs2 NewName, 13, , , , , , , , , , , , , , , 65535
                wdDoc.Close
            Case ".dot"
                Set wdDoc = wdApp.Documents.Open(OldName)
                NewName = Left(OldName, InStrRev(OldName, ".")) & "dotm"
                wdDoc.SaveAs2 NewName, 15, , , , , , , , , , , , , , , 65535
                wdDoc.Close
        End Select
        fso.DeleteFile OldName
    Next
    Set xlWb = Nothing
    xlApp.Quit
    Set xlApp = Nothing
    Set wdDoc = Nothing
    wdApp.Quit
    Set wdApp = Nothing
    Set fso = Nothing
    MsgBox "Converted " & (UBound(Result) + 1) & " files"
Else
    MsgBox "No files found"
End If


Sub GetFiles(FolderPath)

    Dim fso, fld, subf, fil

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(FolderPath)

    For Each fil In fld.Files
        Select Case LCase(Right(fil.Name, 4))
            Case ".xls", ".xlt", ".xla", ".doc", ".dot"
                If IsArray(Result) Then
                    ReDim Preserve Result(UBound(Result) + 1)
                Else
                    ReDim Result(0)
                End If
                Result(UBound(Result)) = fil.Path
        End Select
    Next

    For Each subf In fld.SubFolders
        GetFiles subf.Path
    Next

    Set fil = Nothing
    Set subf = Nothing
    Set fld = Nothing
    Set fso = Nothing

End Sub

Open in new window

0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 37848038
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0
 

Author Comment

by:lou6150
ID: 37857166
Just wanted to thank both JSRWilson and matthewspatrick and apologize for not getting back to this question.  It seems the experts-exchange email notifications were getting filtered by our mail scrubber.

I ended up looking into this more and used the FSO object to accomplish this, very similar to what JSR suggested.  It was easy once I knew I could use that.  Thanks.

The recursive routine the matthewspatrick offered looks great, although I'm not sure what to do with it or where to put it.  I tried dumping it into VBA editor and it didn't work.
0

Featured Post

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now