Home > Microsoft Word, Visual Basic > Converting thousands of text files to Word DOCX

Converting thousands of text files to Word DOCX

Today I had a client ask me to help them convert a bunch of files into Word .DOCX format. The files were in a big tree of folders and subfolders, were of a variety of types, and had mixed extensions. I wrote the following simple VBSCRIPT Macro to process the files.

Option Explicit

Dim fso As Scripting.FileSystemObject
Dim intCount As Integer

Public Sub ProcessDocuments()

    Dim fldRoot As Folder

    'Turn off screen updating
    Application.ScreenUpdating = False

    'Set up scripting engine
    Set fso = New Scripting.FileSystemObject
    intCount = 0
    'First Folder
    Set fldRoot = fso.GetFolder("C:\Users\Chet Cromer\Documents\C2IT Consulting, Inc\Clients\XXX\Document Conversion\Folder1")
    ProcessFolder fldRoot, True, True
    'Second folder
    Set fldRoot = fso.GetFolder("C:\Users\Chet Cromer\Documents\C2IT Consulting, Inc\Clients\XXX\Document Conversion\Folder2")
    ProcessFolder fldRoot, True, True

    'Turn on screen updating
    Application.ScreenUpdating = True

End Sub

Public Sub ProcessFolder(fld As Folder, IncludeSubFolders As Boolean, DeleteSourceFiles As Boolean)
    Dim fil As File
    Dim fldSub As Folder

    'Process files
    For Each fil In fld.Files
        'Check for non MS Word Document
        If UCase(Right(fil.Name, 5)) <> ".DOCX" Then
            ProcessFile fil
            If DeleteSourceFiles = True Then
                fil.Delete
            End If
        End If
    Next fil

    'Process subfolders if requested
    If IncludeSubFolders = True Then
        For Each fldSub In fld.SubFolders
            ProcessFolder fldSub, IncludeSubFolders, DeleteSourceFiles
        Next fldSub
    End If
End Sub

Public Sub ProcessFile(fil As File)
    'Open the file
    Dim doc As Document
    intCount = intCount + 1
    Debug.Print intCount & ": " & fil.Path

    'Debug.Print "Opening " & fil.Path
    Set doc = Application.Documents.Open(FileName:=fil.Path, Visible:=False)

    Dim strNewFile As String
    strNewFile = fil.ParentFolder.Path & "\" & fil.Name & ".DOCX"
    If fso.FileExists(strNewFile) Then
        'Debug.Print "Deleting " & strNewFile
        fso.DeleteFile strNewFile
    End If
    'Debug.Print "Saving " & strNewFile
    doc.SaveAs2 FileName:=strNewFile, fileformat:=wdFormatXMLDocument, addtorecentfiles:=False

    'Mark the doc as saved and close it
    'Debug.Print "Closing " & fil.Path
    doc.Saved = True
    doc.Close False

End Sub
Advertisements
  1. No comments yet.
  1. No trackbacks yet.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: