Populating word document from userform inputs.

  • Thread starter Thread starter David Goodall
  • Start date Start date
D

David Goodall

Hi
I'm trying to develop a userform that generates a word document as well as
populating a spreadsheet. Some of the information from the userform would be
inserted on the doc, similar to a mail merge but only one record at a time.
I have several excel books but none go into great detail about OLE
automation. I am happy creating the userform and adding the data to a
spreadsheet programmically but the automation is a mystery. I would have
thought once the variables are created and stored it is just a matter of
transfering them across to word. Any help is as always greatly appreciated.

Thanks
David
 
Hello,

Here You have some piece of code:
Option Explicit

Sub ExportToWordFile()
Dim retVal As Long, rowCount As Long, colCount As Long
Dim i As Long, j As Long
Dim strFile As String
Dim wrdApp As Word.Application 'declaration
Dim wrdDoc As Word.Document
Dim tbl As Word.Table

On Error GoTo Err_ExportToWordFile

retVal = MsgBox("Do You want to export data to existing
file(YES)" & vbCr & _
"or to new(NO)?" & vbCr & vbCr & _
"Exit = (CANCEL)?", vbQuestion +
vbYesNoCancel, "Question...")
If retVal = vbCancel Then Exit Sub

If retVal = vbYes Then
strFile = GetWordFile 'get Word file to open
Else
strFile = ""
End If

rowCount = ThisWorkbook.Worksheets(1).UsedRange.Rows.Count
colCount = ThisWorkbook.Worksheets
(1).UsedRange.Columns.Count

'create new instance of Word
Set wrdApp = CreateObject("Word.Application")
'open or create document
If strFile = "" Then
Set wrdDoc = wrdApp.Documents.Add
Else
Set wrdDoc = wrdApp.Documents.Open(strFile)
End If

'insert new table
Set tbl = wrdDoc.Tables.Add(wrdDoc.Range, rowCount,
colCount)
For i = 1 To rowCount
For j = 1 To colCount
'insert data form Excel cells to table cells
tbl.Cell(i, j).Range.Text = _
ThisWorkbook.Worksheets(1).Cells(i, j)
Next j
Next i

'after all show Word application
wrdApp.Visible = True

End_ExportToWordFile:
On Error Resume Next
Set tbl = Nothing
Set wrdDoc = Nothing
Set wrdApp = Nothing
Exit Sub

'error handler
Err_ExportToWordFile:
MsgBox Err.Description, vbCritical, Err.Number
Err.Clear
GoTo End_ExportToWordFile
End Sub


Function GetWordFile() As String
Dim strTemp As String

strTemp = Application.GetOpenFilename("Word files
(*.doc),*.doc", , "File to open...", , False)
'on Cancel return value = False then "\" will never be,
ie.: C:\My documets\a.doc
If InStr(1, strTemp, "\", vbTextCompare) = 0 Then strTemp
= ""

GetWordFile = strTemp

End Function

I hope, it will be helpfull.
 
Back
Top