Word 2007 macro to convert file types (pt3)

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
This is an update of a closed thread, which itself was an update of another closed thread (I work for the government, so everything takes forever;) ). U can see pt2 here: http://forums.techguy.org/business-applications/876775-word-2007-macro-convert-file.html#post7030254

Anyway, issues 1 and 3 in that thread were resolved w/ the advice that Rollin_Again gave me. Only issue 2 remains:

2. It would be really helpful to get it to create PDF, rtf, and txt files all in the same folders.
Are you saying that you want to run the macro one time and have it create all 3 files types at the same time without having to modify the code and change the file output manually?
Yes... virtually every time we run this macro, we will need pdf, rtf, and txt versions of the original file in the same folder. So if the input file is in FOLDER1 and is named FILE1.docx, then the output folder should also be called FOLDER1 and it should contain FILE1.pdf, FILE1.rtf, and FILE1.txt.

I've pasted the macro below... it looks to me like some portion of the do-loop that creates the RTF file needs to be replicated twice more and each of those replications needs to be modified slightly to create PDF and TXT files.

'**OPEN THE MICROSOFT VISUAL BASIC EDITOR, CLICK TOOLS >> REFERENCES, AND MAKE
'**SURE THAT "MICROSOFT SCRIPTING RUNTIME" IS CHECKED.

Sub ConvertDocs()

'**CHANGE TO DESIRED DIRECTORY**
Call GetFiles("D:\Desktop\test\", 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


'**IN THE FOLLOWING "IF" LOOP, REPLACE RTF WITH THE DESIRED OUTPUT FILE TYPE**
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)


'**IN THE FOLLING COMMAND, CHANGED docx WITH THE DESIRED INPUT FILE TYPE**
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:=""


'**IN THE FOLLING COMMAND, CHANGED docx WITH THE DESIRED INPUT FILE TYPE,
'**AND rtf AND RTF WITH THE DESIRED OUTPUT FILE TYPE**
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
 
Joined
Sep 4, 2003
Messages
4,912
I'm still confused as to whether the newly saved file will be in their own folder or should they just be created in the same root directory as the .docx file?

Regards,
Rollin
 

syc0path

Thread Starter
Joined
Nov 19, 2004
Messages
275
The current macro creates a new but identical folder structure that contains the converted files but not the original .docx files, and that's what I'd like it to continue to do. Except that now, the new folders would contain .pdf, .txt, and .rtf versions of the original .docx files.
 
Joined
Sep 4, 2003
Messages
4,912
Saving as multiple formats shouldn't be a problem but unfortunately I don't have Office 2007 so I don't have functionality to export directly to PDF. I'll try to find a machine at work with an updated version of Office so that I can do some testing.

creation part.
 
Joined
Sep 4, 2003
Messages
4,912
So far I haven't had much luck finding an Office 2007 machine. I'm not super familiar with Office 2007 but I believe there is a plug in that needs to be downloaded to convert to PDF format. You may want to see if you are able to record a macro while trying to convert to PDF. If you are able to do this please post the code here and I can take and look and try to incorporate it for you with the existing code. I've already got the loop working to create the RTF and TXT files and just need an example of the code for exporting to PDF.

Rollin
 

syc0path

Thread Starter
Joined
Nov 19, 2004
Messages
275
Yes, we do have the plug-in to convert to PDF. I recorded a macro as u suggested:

Sub PDF()
'
' PDF Macro
'
'
ChangeFileOpenDirectory "D:\Desktop\test"
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
"D:\Desktop\test\This is my test file.pdf", ExportFormat:= _
wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
End Sub

Thanx!
 
Joined
Sep 4, 2003
Messages
4,912
Did you get this sorted yet? I finally got Office 2007 installed on one of my machines and can fool around with the code a bit if you still need it.

Regards,
Rollin
 

syc0path

Thread Starter
Joined
Nov 19, 2004
Messages
275
Nope, still haven't gotten it taken care of yet... I posted the macro for converting to PDF, as u see, but I haven't had any luck getting it integrated into the rest of the macro. So I would still appreciate your help -- thanx!
 
Joined
Sep 4, 2003
Messages
4,912
Try the updated code below

Code:
Sub ConvertDocs()

'**CHANGE TO DESIRED DIRECTORY**
Call GetFiles("D:\Desktop\test\", 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


'**IN THE FOLLOWING "IF" LOOP, REPLACE RTF WITH THE DESIRED OUTPUT FILE TYPE**
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) & "_NEW")

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

End If



Set SourceFolder = FSO.GetFolder(FolderName)


'**IN THE FOLLING COMMAND, CHANGED docx WITH THE DESIRED INPUT FILE TYPE**
sFileName = Dir(FolderName & "*.docx")

Do While sFileName <> ""

For i = 1 To 3

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

Select Case i

Case 1

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

Case 2

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

Case 3

ActiveDocument.ExportAsFixedFormat OutputFileName:= _
FolderName & Replace(sFileName, ".docx", ".pdf"), ExportFormat:= _
wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False

End Select




ActiveDocument.Close


Next i

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
It works!!:D It runs perfectly for .docx input files -- it creates all the correct versions of the files, all organized correctly. But there is an issue w/ txt input files -- for some reason, it doesn't produce txt files in the output directory. So if the input is test1.txt, the output will be test1.rtf and test1.pdf only. A similar thing happens w/ .rtf files -- only .txt and .pdf will show up in the output folder. Here is the edited version of the code that's been changed for txt input files:

Sub ConvertDocs()

'**CHANGE TO DESIRED DIRECTORY**
Call GetFiles("D:\user\Desktop\test\", 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


'**IN THE FOLLOWING "IF" LOOP, REPLACE RTF WITH THE DESIRED OUTPUT FILE TYPE**
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) & "_NEW")

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

End If



Set SourceFolder = FSO.GetFolder(FolderName)


'**IN THE FOLLING COMMAND, CHANGE docx WITH THE DESIRED INPUT FILE TYPE**
sFileName = Dir(FolderName & "*.txt")

Do While sFileName <> ""

For i = 1 To 3

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

Select Case i

Case 1

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

Case 2

ActiveDocument.SaveAs filename:=FolderName & Replace(sFileName, ".txt", ".txt"), FileFormat:=wdFormatText, _
LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False

Case 3

ActiveDocument.ExportAsFixedFormat OutputFileName:= _
FolderName & Replace(sFileName, ".txt", ".pdf"), ExportFormat:= _
wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False

End Select




ActiveDocument.Close


Next i

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
 
Joined
Sep 4, 2003
Messages
4,912
Try the updated code below. I've modified it slightly to allow you to browse to the directory where the files are stored. If you don't like it just comment out the lines I added in the first sub and uncomment the original line with the path hard coded. I also made it easier to change the filetype by using a variable instead of hard coded values. To change the file type simply modify the portion in red.

Code:
Sub ConvertDocs()

On Error GoTo EndIt

'Pick Directory to Process

    Dim ShellApp As Object
    Dim vDirectory As String
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
    vDirectory = ShellApp.self.Path & "\"
    Call GetFiles(vDirectory, True, True)
    End
    
'or uncomment and use the line of code below to hard code path
'Call GetFiles("D:\Desktop\test\", True, True)

EndIt:

If Err.Number = 91 Then
MsgBox ("Please Select Valid Directory")
End If

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) & "_NEW")

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

End If



Set SourceFolder = FSO.GetFolder(FolderName)

'**IN THE FOLLING COMMAND, CHANGED docx WITH THE DESIRED INPUT FILE TYPE**
[COLOR="Red"]vFileType = ".txt"[/COLOR]


sFileName = Dir(FolderName & "*" & vFileType)

Do While sFileName <> ""

For i = 1 To 3

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

Select Case i

Case 1

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

Case 2

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

Case 3

ActiveDocument.ExportAsFixedFormat OutputFileName:= _
FolderName & Replace(sFileName, vFileType, ".pdf"), ExportFormat:= _
wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False

End Select


ActiveDocument.Close


Next i

sFileName = Dir
Loop


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

End Sub



Rollin
 

syc0path

Thread Starter
Joined
Nov 19, 2004
Messages
275
I finally got a chance to play w/ the newest code. I really like the option to choose the input folder rather than having to enter the path! Now I'm spoiled -- any way u can do something similar to choose the input file type rather than having to edit the macro?? Even if there isn't, it's still nice that I only have to change the input file type in 1 place.

There is another minor issue though... if the input file type is .doc or .docx, the .doc/.docx files are copied into the output folder. Similarly, if the input is .txt, .rtf files are created even though they aren't necessary (they can't provide any more formatting info than the original .txt files). It's not that big of a deal, becuz I can search the top-level folder for doc/docx/rtf files and delete them, but it would be nice if they weren't there.
 
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

Staff online

Top