KrishTalk.com

How to create MS Word document automatically with Text file

This VBA code will help you to import data from a text file and insert it into the MS word document. This is useful when you have to create a report or formats in MS Word format, reading the data from a text file. The VBA code can be extended import extra data from the text file, and also you can add additional format as per your needs.

Please note that VBA macros can cause harm to your computer. First, open them in a disabled mode. To disable macros, to Developer tab, select macro security and then select Macro settings on the left side pane. In the right pane, select the second radio button, 'Disable all macros with notification'. The second option is better because it will notify you if there are any macros associated with your file. So you will not miss any document features that may be available after running a macro. But you can decide whether to allow the macros to run or not.

Please click on the below link to download the MS Word Template file. You can also download the text file used to import the data. I remind you that this is a sample file. You may have to modify the VBA code according to your requirement. You may have to rename the input file.

Please leave a comment below if you have any concerns.
MS word template

The VBA Code
-------------------
Sub Document_Open()
If (ActiveDocument.Name = "Template.docm") Then
With ActiveDocument

On Error Resume Next
.Variables.Add Name:="1", Value:="1"
.Variables.Add Name:="2", Value:="2"
.Variables.Add Name:="3", Value:="3"
.Variables.Add Name:="4", Value:="4"
.Variables.Add Name:="5", Value:="5"
.Variables.Add Name:="6", Value:="6"

Dim ReadData As String
Dim myarray() As String

Open ActiveDocument.Path & "\text.txt" For Input As #1

Do Until EOF(1)
Line Input #1, ReadData
If Not Left(ReadData, 1) = "*" Then
myarray = Split(ReadData, ",")
End If

Loop

Close #1

i = 1
For Each f In myarray
.Variables(i).Value = f
i = i + 1
Next f
.Fields.Update
End With

With ActiveDocument
strFileName = "Agreement Between " & myarray(5) & " and " & myarray(0)
strPath = .Path

.SaveAs2 (strPath & "\" & strFileName)
'.Close SaveChanges:=wdDoNotSaveChanges
Application.Quit SaveChanges:=wdDoNotSaveChanges
'.Application.
End With
End If
End Sub
-------------------

MS Excel Currency converter VBA code

To convert numbers into text, there is no builtin function in MS Excel as of now. Using the below VBA code you can overcome this issue. There are situations like writing a cheque leaf, printing a rent agreement, or writing contract documents that may require printing the transaction amount in the text. Make use of this code to convert numbers into text automatically.

Copy and paste this VBA code into your Excel VBA editor module. Or Insert an empty module and paste this code.

Attribute VB_Name = "Module1"
'Attribute VB_Name = "Module2"
' **** Author : Krishna S
' **** Tittle : Converting Hindu Arabic Currency(Indian System) to Words
' **** Copyright Owner : Krishna S
' **** Description : This utility converts currencies in Indian numbering system to words.
' **** Limitations : Converts only upto 10,00,00,000( Ten Crores)
Function ConvertCurrencyToEnglish(ByVal MyNumber)
Dim Temp
Dim Rupees, Paise
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Thousand "
Place(3) = " Lac "
Place(4) = " Core "
' Place(5) = " Hundred Core "
' Convert MyNumber to a string, trimming extra spaces.
MyNumber = Trim(Str(MyNumber))
' Find decimal place.
DecimalPlace = InStr(MyNumber, ".")
' If we find decimal place...
If DecimalPlace > 0 Then
' Convert Paise
Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
Paise = ConvertTens(Temp)
' Strip off Paise from remainder to convert.
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
If Count = 1 Then
Temp = ConvertHundreds(Right(MyNumber, 3))
If Temp <> "" Then Rupees = Temp & Place(Count) & Rupees
If Len(MyNumber) > 3 Then
' Remove last 3 converted digits from MyNumber.
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Else
' Convert last 3 digits of MyNumber to English Rupees.
If Len(MyNumber) = 1 Then
Temp = ConvertDigit(MyNumber)
Else
Temp = ConvertTens(Right(MyNumber, 2))
End If
If Temp <> "" Then Rupees = Temp & Place(Count) & Rupees
If Len(MyNumber) >= 3 Then
' Remove last 3 converted digits from MyNumber.
MyNumber = Left(MyNumber, Len(MyNumber) - 2)
Else
MyNumber = ""
End If
Count = Count + 1
End If
Loop
' Clean up Rupees.
Select Case Rupees
Case ""
Rupees = ""
Case "One"
Rupees = "One Rupee"
Case Else
Rupees = Rupees & " Rupees"
End Select
' Clean up Paise.
Select Case Paise
Case ""
Paise = ""
Case "One"
Paise = " And One Cent"
Case Else
Paise = " And " & Paise & " Paise"
End Select
ConvertCurrencyToEnglish = Rupees & Paise
End Function
Private Function ConvertHundreds(ByVal MyNumber)
Dim Result As String
' Exit if there is nothing to convert.
If Val(MyNumber) = 0 Then Exit Function
' Append leading zeros to number.
MyNumber = Right("000" & MyNumber, 3)
' Do we have a hundreds place digit to convert?
If Left(MyNumber, 1) <> "0" Then
Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "
End If
' Do we have a tens place digit to convert?
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & ConvertTens(Mid(MyNumber, 2))
Else
' If not, then convert the ones place digit.
Result = Result & ConvertDigit(Mid(MyNumber, 3))
End If
ConvertHundreds = Trim(Result)
End Function
Private Function ConvertTens(ByVal MyTens)
Dim Result As String
' Is value between 10 and 19?
If Val(Left(MyTens, 1)) = 1 Then
Select Case Val(MyTens)
Case 1: Result = "One"
Case 10: Result = "Ten"
Case 11: Result = "Eleven"
Case 12: Result = "Twelve"
Case 13: Result = "Thirteen"
Case 14: Result = "Fourteen"
Case 15: Result = "Fifteen"
Case 16: Result = "Sixteen"
Case 17: Result = "Seventeen"
Case 18: Result = "Eighteen"
Case 19: Result = "Nineteen"
Case Else
End Select
Else
' .. otherwise it's between 20 and 99.
Select Case Val(Left(MyTens, 1))
Case 2: Result = "Twenty "
Case 3: Result = "Thirty "
Case 4: Result = "Forty "
Case 5: Result = "Fifty "
Case 6: Result = "Sixty "
Case 7: Result = "Seventy "
Case 8: Result = "Eighty "
Case 9: Result = "Ninety "
Case Else
End Select
' Convert ones place digit.
Result = Result & ConvertDigit(Right(MyTens, 1))
End If
ConvertTens = Result
End Function
Private Function ConvertDigit(ByVal MyDigit)
Select Case Val(MyDigit)
Case 1: ConvertDigit = "One"
Case 2: ConvertDigit = "Two"
Case 3: ConvertDigit = "Three"
Case 4: ConvertDigit = "Four"
Case 5: ConvertDigit = "Five"
Case 6: ConvertDigit = "Six"
Case 7: ConvertDigit = "Seven"
Case 8: ConvertDigit = "Eight"
Case 9: ConvertDigit = "Nine"
Case Else: ConvertDigit = ""
End Select
End Function

How to merge 2 or more MS word documents

How to merge 2 or more MS word documents. You can do this by manually copying the first file and pasting on to the second file. But if you have too many files to merge and if you have to do it repeatedly, it's better to have automated setup.

Below macro will help you to merge 2 documents. You can edit the VBA code and add more files if you want. After merging, it will save as a new document. By default, it will save the new merged file under My Documents. If you want the new files to be saved under a specific location, you can mention that the file name section

Sub Merge_2_files()

' Merge 2 files and save as a new document

NewFileName = "NewFile_" & Minute(Now) & "_" & Second(Now) & ".docx"

Selection.EndKey Unit:=wdStory

Selection.TypeParagraph

Selection.InsertFile FileName:="C:\Users\inksanjeev\Desktop\A folder\Specifications.docx", Range:="", _

ConfirmConversions:=False, Link:=False, Attachment:=False

ActiveDocument.SaveAs2 FileName:=NewFileName, FileFormat:= _

wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _

:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _

:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _

SaveAsAOCELetter:=False, CompatibilityMode:=15

End Sub

Download the files
File 1

File 2

How to create MS Word document automatically with Text file

MS Excel Currency converter VBA code

How to merge 2 or more MS word documents

Contact Form