How to Save a word as text file after applying font with UTF-8

[jkathir]

Hi,

i have word file which shows boxes when i opened. However when choosing a particular font, the text is being displayed. I selected all the content of the document with ctr+a and changed the font and save as .txt file with UTF-8.

Everything works fine and all are good.



Is there is any macro can do this automatically? Basically applying a font for entire document and save as .txt file with UTF-8?

Any tool or software does this?

Thanks.

[gmayor]

How about the following. Change the font name as appropriate.

Sub SaveUnicode()
Dim strName As String
Const strFont As String = "Times New Roman"    'the font to apply
    If Len(ActiveDocument.Path) > 0 Then
        strName = Left(ActiveDocument.FullName, InStrRev(ActiveDocument.FullName, ".") - 1) & ".txt"
    Else
        strName = Options.DefaultFilePath(wdDocumentsPath) & "\MyDocument.txt"
    End If
    ActiveDocument.Range.Font.Name = strFont
    ActiveDocument.SaveAs2 FileName:=strName, FileFormat:=wdFormatUnicodeText
End Sub

[jkathir]

How to execute the given VBA script for all the documents

I have huge documents...Do i need to manually open each and every document and execute the VBA

Please let me know how to apply VBA for huge documents.

[jkathir]

i'm looking for a way to apply for all documents in a folder. I don't find a sample or way for word ...(ex: VBA Run Macro on All Files in a Folder / All Worksheets in a Workbook - Analyst Cave for excel)

[gmayor]

I hesitate to recommend this as it may create as many problems as it resolves, but assuming the previous macro worked and I don't see why it would as text files don't support fonts, then the following will process all the documents that match the parameters in the selected folder. Password protected documents are ignored.
The original files are unaltered.

Sub ProcessFolder()
'Graham Mayor - https://www.gmayor.com - Last updated - 25 Aug 2019
Dim strFile As String
Dim strPath As String
Dim oDoc As Document
Dim fDialog As FileDialog
Dim strName As String
Dim oColl As Collection
Dim iCol As Integer
Const strPassword As String = "?#nonsense@$" 'do not change
Const strExt As String = "doc"    'the extension of the files to process - here word 97-2003 DOC format.
Const strFont As String = "Times New Roman"    'the font to apply (text files do not support fonts?)

    Set oColl = New Collection
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With fDialog
        .TITLE = "Select folder and click OK"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then
            MsgBox "Cancelled By User", , "List Folder Contents"
            Exit Sub
        End If
        strPath = fDialog.SelectedItems.Item(1)
        Do Until Right(strPath, 1) = Chr(92)
            strPath = strPath & Chr(92)
        Loop
    End With
    strFile = Dir$(strPath & "*.*")
    While strFile <> ""
        If LCase(Right(strFile, Len(strFile) - InStrRev(strFile, "."))) = strExt Then
            oColl.Add strPath & strFile
        End If
        DoEvents
        strFile = Dir$()
    Wend
    For iCol = 1 To oColl.Count
        On Error Resume Next
        WordBasic.DisableAutoMacros 1
        Set oDoc = Documents.Open(FileName:=oColl(iCol), _
                                  AddToRecentFiles:=False, _
                                  Visible:=True, _
                                  PasswordDocument:=strPassword, _
                                  ReadOnly:=True, _
                                  WritePasswordDocument:=strPassword)
        If oDoc Is Nothing Or Err.Number > 0 Then
            Err.Clear
            GoTo NextDoc:
        End If
        strName = Left(oDoc.FullName, InStrRev(oDoc.FullName, ".") - 1) & ".txt"
        oDoc.Range.Font.Name = strFont
        oDoc.SaveAs2 FileName:=strName, FileFormat:=wdFormatUnicodeText
        oDoc.Close SaveChanges:=wdDoNotSaveChanges
        WordBasic.DisableAutoMacros 0
NextDoc:
        DoEvents
    Next iCol
    MsgBox "Processing complete"
lbl_Exit:
    Set oDoc = Nothing
    Set fDialog = Nothing
    Set oColl = Nothing
    Exit Sub
End Sub

[jkathir]

Thank you so much...I will test and let you know...How to do the same process to preserve the changes in docx format itself?

[Guessed]

Change the line
oDoc.Close SaveChanges:=wdDoNotSaveChanges

to
oDoc.Close SaveChanges:=True

[gmayor]

That won't work. If you save as TXT, oDoc is then the text file that you have just saved.

To save the file as docx, you would either have to forget saving as txt and save as docx, or simply save oDoc instead of saving it as txt. e.g.

        'strName = Left(oDoc.FullName, InStrRev(oDoc.FullName, ".") - 1) & ".txt"
        'oDoc.Range.Font.Name = strFont
	oDoc.Save
        'oDoc.SaveAs2 FileName:=strName, FileFormat:=wdFormatUnicodeText
        oDoc.Close SaveChanges:=wdDoNotSaveChanges

If you want it as txt as well as docx then

        strName = Left(oDoc.FullName, InStrRev(oDoc.FullName, ".") - 1) & ".txt"
        oDoc.Range.Font.Name = strFont
	oDoc.Save
        oDoc.SaveAs2 FileName:=strName, FileFormat:=wdFormatUnicodeText
        oDoc.Close SaveChanges:=wdDoNotSaveChanges

Or SaveAs again e.g.

        strName = Left(oDoc.FullName, InStrRev(oDoc.FullName, ".") - 1) & ".txt"
        oDoc.Range.Font.Name = strFont
        oDoc.SaveAs2 FileName:=strName, FileFormat:=wdFormatUnicodeText
	strName = Left(oDoc.FullName, InStrRev(oDoc.FullName, ".") - 1) & ".docx"
	oDoc.SaveAs2 FileName:=strName, FileFormat:=wdFormatXMLDocument
        oDoc.Close SaveChanges:=wdDoNotSaveChanges

[jkathir]

Thanks a lot. I will test and get back

[jkathir]

1. I understand the above macro
2. How to run this macro? should i open any word document
3. I tried but not sure how to run the above macro. Help me with screenshot if possible

[gmayor]

See Installing Macros

[Lugh]

Originally Posted by jkathir

2. How to run this macro? should i open any word document

I'm no expert, but I expect the following will work:

Open the Word template you are using—Normal is the default.
Open the VBA editor—Alt+F11.
Paste Graham's code into a module—Module1 is the default.
Save the code in the editor.
If asked to save changes to template, select whatever corresponds to 'Yes'.
Close the template.

If you like, customize your Ribbon by adding the macro to a new button on it.

Open a doc in the folder, then run the macro.