Option Declare
Use "Common"

' Global Variables
Dim FoldersList List As String
Dim NumFolders As Long

Sub Initialize
	Dim WordApplication As Variant
	Dim WordDoc As Variant
	
	Dim BaseFileName As String
	Dim FileName As String
	Dim FileNameList List As Integer
	Dim FilePattern As String
	Dim NumFiles As Long
	Dim SourceFolder As String
	Dim TargetFileName As String
	Dim TargetFolder As String
	Dim ThisFolderName As String
	
	Const SOURCE_FILE_EXT = "rtf"
	Const TARGET_FILE_EXT = "docx"

	' MS-Word Constants
	Const wdFormatDocument = 0
	Const wdFormatDocumentDefault = 16
	Const wdCurrent = 65535
	
	' Error Handler
	On Error GoTo Error_Handler
	
	Call Initialize_Common()
	
	' Set the top level folder containing all the RTF files to be converted
	SourceFolder = "c:\Temp\Export\Word\"
	
	Set WordApplication = Nothing
	
	Err = 0
	On Error Resume Next
	Set WordApplication = CreateObject("Word.Application")
	If Not IsObject(WordApplication) Or Err <> 0 Then
		' Application not successfully initialized - Try GetObject method
		Err = 0
		Set WordApplication = GetObject("", "Word.Application")
	End If
	
	If Not IsObject(WordApplication) Or Err <> 0 Then
		MessageBox "The Word Application could not be instantiated. Please ensure it is installed on this machine.", 0+16, "Cannot Initialize Word"
		Exit Sub
	End If
	
	On Error GoTo Error_Handler
	
	WordApplication.Visible = False
	WordApplication.DisplayAlerts = False
	
	' Get all folders / subfolders
	Call GetFoldersList(SourceFolder)
	If NumFolders = 0 Then
		MessageBox "No folders were found or subfolders were found at " & SourceFolder & ".", 0+16, "No Folders Found"
		Exit Sub
	End If

	' Get all the rtf files
	FilePattern = "*." & SOURCE_FILE_EXT

	ForAll v_Folder In FoldersList
		NumFiles = 0
		Erase FileNameList

		ThisFolderName = ListTag(v_Folder)
		
		Call FileSystemObject.GetFilesInFolder(ThisFolderName, FileNameList, NumFiles, FilePattern)
	
		If NumFiles = 0 Then
			' No files were found
			GoTo Next_Folder
		End If

		Print "Found " & Trim(CStr(NumFiles)) & " files at " & ThisFolderName
	
		ForAll v_FilePathName In FilenameList
			FileName = ListTag(v_FilePathName)
		
			TargetFileName = StrLeftBack(FileName, SOURCE_FILE_EXT, 5)
			TargetFileName = TargetFileName & TARGET_FILE_EXT

			BaseFileName = FileName
			If InStr(1, BaseFileName, "\") > 0 Then
				BaseFileName = StrRightBack(BaseFileName, "\")
			ElseIf InStr(1, BaseFileName, "/") > 0 Then
				BaseFileName = StrRightBack(BaseFileName, "/")
			End If

			Print "Converting file: " & BaseFileName
		
			' Open the file
			Set WordDoc = WordApplication.Documents.Open(FileName, False)
		
			' Save the RTF file as a docx
			Call WordDoc.SaveAs2(TargetFileName, wdFormatDocumentDefault, , , , , , , , , , , , , , , wdCurrent)
		
			' Close the file
			Call WordDoc.Close
		
			Set WordDoc = Nothing
			
			' Remove the RTF file if the docx file was successfully created
			If FileSystemObject.FileExists(TargetFileName) Then
				Call FileSystemObject.RemoveFile(FileName)
			End If
		End ForAll

Next_Folder:
	End ForAll
		
Exit_Sub:
	On Error Resume Next

	' Close Word
	If Not WordApplication Is Nothing Then
		Call WordApplication.Quit
		Set WordApplication = Nothing
	End If
	
	Exit Sub
	
Error_Handler:
    Call Output_Error("Post Export Custom Script - Initialize", Erl, True, True)
    Resume Exit_Sub
End Sub

Function GetFoldersList(FolderName As String) As Boolean
	' Get the list of folders in this folder
	Dim ThisFolderList List As Variant
	Dim ThisNumFolders As Long
	Dim ThisFolderName As String
	
	' Error Handler
	On Error GoTo Error_Handler
	
	If Not IsElement(FoldersList(FolderName)) Then
		FoldersList(FolderName) = 1
		NumFolders = NumFolders + 1
	End If
	
	If FileSystemObject.GetSubFolders(FolderName, ThisFolderList, ThisNumFolders) Then
		If ThisNumFolders > 0 Then
			ForAll v_Folder In ThisFolderList
				ThisFolderName = ListTag(v_Folder)
				If Not IsElement(FoldersList(ThisFolderName)) Then
					FoldersList(ThisFolderName) = 1
					NumFolders = NumFolders + 1
					
					Call GetFoldersList(ThisFolderName)
				End If
			End ForAll
		End If
	End If
	
	GetFoldersList = True
	Exit Function
	
Error_Handler:
	Call Output_Error("Post Export Custom Script - GetFoldersList", Erl, True, True)
	Exit Function
End Function