Solved: Word 2007 macro to convert file types?

Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

syc0path

Thread Starter
Joined
Nov 19, 2004
Messages
275
So I have a batch of about 750 Word documents that need to be converted to RTF. I recorded a macro that looks something like this:

quote:

Sub rtf3()
'
' rtf3 Macro
'
'
Documents.Open FileName:="D:\user\Desktop\test\1.docx", ConfirmConversions:=False, ReadOnly:= _
False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:= _
"", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", _
Format:=wdOpenFormatAuto, XMLTransform:=""
ActiveDocument.SaveAs FileName:="D:\user\Desktop\test\1.rtf", FileFormat:=wdFormatRTF, _
LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False
ActiveDocument.Close


It works fine, but there are a couple of problems w/ it. 1, I have to repeat it over and over for each file, and 2, each repetition has to be edited w/ the next filename, the path to that file, and the new filename. I figured out a way to partially automate that process, but it's still a PITA .

Can't I just tell it to get all the .docx files in this folder and all its subfolders and save them as an RTF w/ the original filename?
 
Joined
Sep 4, 2003
Messages
4,912
Open the VB editor and click TOOLS >> REFERENCES and add reference to Microsoft Scripting Runtime

Next paste the code below into a blank module and change the file path highlighted in red to reflect the true path where your documents are saved. If you want the macro to search subdirectories keep the portion highlighted in purple as TRUE. If you don't want subdirectories searched then change the value to FALSE. Save and then run the macro called ConvertDocs

The macro will save the RTF files to the same directory as the original documents. If you want to save elsewhere let me know and we can dump them into a different directory of your choice. Hope this helps!!

Code:
Sub ConvertDocs()
 
Call GetFiles("[COLOR="Red"]C:\Test\[/COLOR]", [COLOR="DarkOrchid"]True[/COLOR])

End Sub
 
Sub GetFiles(FolderName As String, CheckSubfolders As Boolean)

Dim sFileName As String
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long

Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(FolderName)
 
sFileName = Dir(FolderName & "*.docx")

Do While sFileName <> ""

Documents.Open FileName:=FolderName & sFileName, ConfirmConversions:=False, ReadOnly:= _
False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:= _
"", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", _
Format:=wdOpenFormatAuto, XMLTransform:=""


ActiveDocument.SaveAs FileName:=FolderName & Replace(sFileName, ".docx", ".rtf"), FileFormat:=wdFormatRTF, _
LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False

ActiveDocument.Close
 sFileName = Dir
Loop
    

    If CheckSubfolders = True Then
        For Each SubFolder In SourceFolder.SubFolders
            GetFiles SubFolder.Path & "\", True
        Next SubFolder
    End If
 
End Sub
 
Joined
Nov 22, 2007
Messages
262
This assumes the files are on the desktop in a folder called Files
Code:
Sub DocsinFolder()
' Run a macro of your choosing on each presentation in a folder

    Dim rayFileList() As String
    Dim FolderPath As String
    Dim FileSpec
    Dim strTemp As String
    Dim x As Long

    
    FolderPath = Environ("USERPROFILE") & "\Desktop\Files\"
    FileSpec = "*.docx"
    ' END OF EDITS

    ' Fill the array with files that meet the spec above
ReDim rayFileList(1 To 1)
    strTemp = Dir$(FolderPath & FileSpec)
    While strTemp <> ""
     ReDim Preserve rayFileList(1 To UBound(rayFileList) + 1) As String
        rayFileList(UBound(rayFileList)) = FolderPath & strTemp
       
        strTemp = Dir
    Wend

    If UBound(rayFileList) > 1 Then
        For x = 1 To UBound(rayFileList)
            Call Rename(rayFileList(x))
        Next x
    End If

End Sub

Sub Rename(strMyFile As String)
Dim oDoc As Document
Dim oldName As String
Dim newName As String
On Error Resume Next

Set oDoc = Documents.Open(strMyFile)
MkDir (oDoc.Path) & "\rtf\"
oldName = oDoc.Name
newName = Replace(oDoc.Name, "docx", "rtf")
oDoc.SaveAs (oDoc.Path & "\rtf\" & newName)
oDoc.Close
End Sub
Based on code by Steve Rindsberg
 
Joined
Sep 4, 2003
Messages
4,912
The code posted by JohnWilson ignores subdirectories within the main directory. The code I provided will process all docs in both the main directory as well as the subdirectory. In addition to this, JohnWilson's code includes a FOR loop (For x = 1 To UBound(rayFileList). The only problem with this loop is that the first element at index 1 will always be empty since the first element to be assigned a value is element 2 as seen in the code below. I didn't try running his code but it may result in an error since you would be trying to open a document that doesn't exist at element 1.

Code:
     ReDim Preserve rayFileList(1 To UBound(rayFileList) + 1) As String
        rayFileList(UBound(rayFileList)) = FolderPath & strTemp
Regards,
Rollin
 

syc0path

Thread Starter
Joined
Nov 19, 2004
Messages
275
Rollin, when I tried to run your code, I got this error:

"Compile Error:
User-defined type not defined"

And it highlighted this line: "FSO As Scripting.FileSystemObject"


John, your code works, but as Rollin said, it does not check subdirectories. The 750 files I'm trying to convert are nested 3 levels deep, and there are a total of 75 subdirectories. Not only that, but if we get this figured out, several people at my work will be using this macro for other groups of files. So it would be really helpful if we could get the subdirectory thing to work.

BTW, just so we're all on the same page, I'm using a folder on my desktop called "test", which includes a subdirectory called "subtest"
 
Joined
Sep 4, 2003
Messages
4,912
Did you set reference to Microsoft Scripting Runtime as I instructed you in my first post?

Open the VB editor and click TOOLS >> REFERENCES and add reference to Microsoft Scripting Runtime

Regards,
Rollin
 

syc0path

Thread Starter
Joined
Nov 19, 2004
Messages
275
Did you set reference to Microsoft Scripting Runtime as I instructed you in my first post?
No, I forgot to do that... sorry. But now that I did that, it works!:D Thanx so much for your help!!

The macro will save the RTF files to the same directory as the original documents. If you want to save elsewhere let me know and we can dump them into a different directory of your choice.
What would be ideal would be if it could create an identical folder/file structure, except w/ RTFs instead of docx's. As it stands right now, what I planned to do was to make a copy of the whole thing, run the macro, and then do a search in the copy of the directory for *.docx. Then I could delete all of the docx files and leave only the RTFs. That way we would preserve the original files while still creating an organized collection of RTFs.

Also, I have a meeting on this next week, and I think the overall process will be something like this: we receive files in a variety of formats (doc, docx, txt, and maybe even Excel or Access). Those files then need to converted to rtf so they can be run thru an editing script in Linux. Could this macro be easily adapted to convert from other formats to rtf?
 
Joined
Sep 4, 2003
Messages
4,912
Try the updated code below. The macro will first automatically copy the original source directory before executing. Since the code will then be executed on the copied directory you will have your original directory and original files entact. The portion of code in red is the original file path and the new directory will have the same path and name except for that I have appended an underscore ( _ ) and the letters "RTF" to the end so that C:\Test\ will become C:\Test_RTF. This new directory should only contain .rtf files after the macro is finished running. Hope this helps!!



Code:
Sub ConvertDocs()
 
Call GetFiles("[COLOR="Red"]C:\Test[/COLOR]\", True, True)

End Sub
 
Sub GetFiles(FolderName As String, CheckSubfolders As Boolean, vCopy As Boolean)

Dim sFileName As String
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File

Set FSO = New Scripting.FileSystemObject

If vCopy = True Then

FSO.CopyFolder Left(FolderName, Len(FolderName) - 1), _
Replace(Left(FolderName, Len(FolderName) - 1), Mid(Left(FolderName, Len(FolderName) - 1), 4), _
Mid(Left(FolderName, Len(FolderName) - 1), 4) & "_RTF")

FolderName = Replace(Left(FolderName, Len(FolderName) - 1), Mid(Left(FolderName, Len(FolderName) - 1), 4), _
Mid(Left(FolderName, Len(FolderName) - 1), 4) & "_RTF\")

End If

Set SourceFolder = FSO.GetFolder(FolderName)

 
sFileName = Dir(FolderName & "*.docx")

Do While sFileName <> ""

Documents.Open FileName:=FolderName & sFileName, ConfirmConversions:=False, ReadOnly:= _
False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:= _
"", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", _
Format:=wdOpenFormatAuto, XMLTransform:=""


ActiveDocument.SaveAs FileName:=FolderName & Replace(sFileName, ".docx", ".rtf"), FileFormat:=wdFormatRTF, _
LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False

ActiveDocument.Close

Kill FolderName & sFileName

 sFileName = Dir
Loop
    

    If CheckSubfolders = True Then
        For Each SubFolder In SourceFolder.SubFolders
            GetFiles SubFolder.Path & "\", True, False
        Next SubFolder
    End If
 
End Sub
Regards,
Rollin
 

syc0path

Thread Starter
Joined
Nov 19, 2004
Messages
275
That's PERFECT!!:D I really like how it copies the directory and then replaces the .docx files w/ .rtf -- I didn't think about it before, but there could be other documentation files that don't need to be converted that give details about the .docx files. This way, those documentation files are included in the rtf output directory.

I also played around w/ different file types and I'm happy to report that it's pretty ez to change the macro to handle various types of input and output files:D

Thank u so much for your help w/ this -- this is gonna help a lot of us in the organization. Thanx again!
 
Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 807,865 other people just like you!

Latest posts

Members online

Top