[syc0path]

This is an update of a closed thread... u can see the original here: http://forums.techguy.org/business-a...o-convert.html

So I've got the macro and it works great -- for converting doc/docx to PDF or rtf. But there are 3 issues that still need to be addressed.

1. I can't get it to work to convert to txt properly -- it gives me an output txt file that includes a bunch of formatting instructions like font, color, spacing, etc.

2. It would be really helpful to get it to create PDF, rtf, and txt files all in the same folders. So for instance, I've got Folder1 and inside that is SubfolderA (which contains A.doc) and SubfolderB (which contains B.doc). I'd like the output to be Folder1\SubfolderA, and inside SubfolderA is A.pdf, A.txt, and A.rtf. SubfolderB would contain B.pdf, B.txt, and B.rtf.

3. So far, 3 other people on this committee have tried the macro on their computers, but it only works on mine (and all 3 of them have checked "Microsoft Scripting Runtime"). And I had to delete all the existing macros in Word to get mine to work -- it seems like I can only have 1 macro at a time. 1 of the computers doesn't do anything when we try to run the macro, and the other 2 give this error: Run-time error '76': Path not found" even though the path in the macro was edited to be correct for that machine. This section below was highlighted after clicking “Debug”...

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


Here is the macro that we've been using:

'**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:\maddenb\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

[Rollin_Again]

1. I can't get it to work to convert to txt properly -- it gives me an output txt file that includes a bunch of formatting instructions like font, color, spacing, etc.

When you run the macro to save the files as text are you changing the actual output format type in the macro? My guess is that you are only changing the portion of the code that replaces the filename extension and not the actual file type. The portion of the code that I highlighted in red below should also be changed to FileFormat:=wdFormatText.

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?

3. So far, 3 other people on this committee have tried the macro on their computers, but it only works on mine (and all 3 of them have checked "Microsoft Scripting Runtime")

Are all 3 computers running the same version of Word?

Have you checked to make sure all upper and lower case letter match what is listed in the the folder path since it IS case sensitive. Did you also make sure there is a backslash at the end of the directory path? Call GetFiles("D:\maddenb\Desktop\test\", True, True)

Also, there is also no reason for you to have to delete other macros on your computer for this macro to run. Where you getting an error before when the other macros were installed?

Sub ConvertDocs()

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