Hey,
New poster. Just learning VB6. I want to create a form that will take
inserted data from the user, easy to do with a form and some controls. What I want to do from there is place it onto multiple templates I have created and print them, then delete the new docs. I have not been able to figure out how to insert data into a particular area of a word document from a user interface.
Any Suggestions

In the intrest of time I am going to insert a function I use to extract data from a SQL server database and insert it to a MS Word document unmodified. That means you will have to take from the function what you need I can make myself available to answer some of your questions.

Some things you will need to do:

1. Create a reference to MS Word in your VB application.
2. Create a word document and insert bookmarks where you want your data to placed.

Here is the function:

Public Function SaveAsDOC(ByVal WorkOrder As String, Optional ByVal DestinationDir As String = "PrintOnly", _
Optional ByVal PrintDoc As Boolean = False, Optional ByVal AsRelease As Boolean = False) As Long

    Dim strLastChar As String
    Dim lError As Long
    Dim strError As String
    Dim rs As ADODB.Recordset
    Dim lx As Long
    Dim oWord As Word.Application
    Dim oWordDoc As Word.Document
    Dim oRng As Word.Range
    Dim oTable As Word.Table
    Dim oBookMark As Word.Bookmark

    On Error GoTo ErrorHandler

    ' Create new object instances
    Set oWord = New Word.Application
    Set oWordDoc = oWord.Documents.Add(GetVaultPath & "\Forms\DIS.doc")
    ' See if the connection is already established
    CheckGlobalDBConnections
    ' Define sproc
    With gCmd
        .CommandText = "bsp_GetDIS"
        .CommandType = adCmdStoredProc
        ' Set params
        .Parameters("@Workorder") = Trim(WorkOrder)
        ' Execute sproc
        Set rs = .Execute()
    End With
    ' Test for records
    If rs.BOF And rs.EOF Then
        ' There are no records
        ' Leave gracefully
        rs.Close
        Set rs = Nothing
        ' Raise error
        Err.Raise 1 + vbObjectError, "SaveAsDOC", "No records found for Work Order " & Trim(WorkOrder)
    End If
    ' Move to the first record in the recordset
    rs.MoveFirst
    ' Build the word document
    Set oRng = oWordDoc.Bookmarks("CustomerName").Range
    oRng.InsertAfter rs!CustomerName
    Set oRng = oWordDoc.Bookmarks("WorkOrder").Range
    oRng.InsertAfter rs!WorkOrder
    Set oRng = oWordDoc.Bookmarks("ReleasedBy").Range
    oRng.InsertAfter rs!FName & " " & rs!LName
    Set oRng = oWordDoc.Bookmarks("ReleaseDate").Range
    oRng.InsertAfter IIf(AsRelease = True, Format(Now(), "mmmm dd, yyyy"), "Pre-release copy")
    Set oRng = oWordDoc.Bookmarks("PreparedBy").Range
    oRng.InsertAfter rs!PreparedBy
    Set oRng = oWordDoc.Bookmarks("PrintedOn").Range
    oRng.InsertAfter Format(Now(), "mmmm dd, yyyy")
    Set oRng = oWordDoc.Bookmarks("Spacer").Range
    oRng.InsertAfter " "
    ' Create a table and add the data to the cells
    ' Add one to the number of rows to account for the header info
    Set oTable = oWordDoc.Tables.Add(oRng, rs.RecordCount + 1, 2)
    Set oRng = oWordDoc.Range
    oRng.Collapse wdCollapseEnd
    oTable.Columns.AutoFit ' Set auto fit to true
    ' Record the header info
    Set oRng = oTable.Cell(1, 1).Range
    oRng.Font.Bold = True
    oRng.Text = "Drawing File"
    Set oRng = oTable.Cell(1, 2).Range
    oRng.Font.Bold = True
    oRng.Text = "Description"
    ' Loop through each record
    ' Start at two because we already have entered the
    ' header information and want to start on the
    ' second row
    For lx = 2 To rs.RecordCount + 1
        ' Set word wrap to true
        oTable.Cell(lx, 1).WordWrap = True
        Set oRng = oTable.Cell(lx, 1).Range
        oRng.Text = rs!FullDocumentName
        ' Set word wrap to true
        oTable.Cell(lx, 2).WordWrap = True
        Set oRng = oTable.Cell(lx, 2).Range
        oRng.Text = rs!Description
        ' Advance to the next record
        rs.MoveNext
    Next lx
    ' Test to see if we are printing the document, call print preview
    If PrintDoc = True Then
        ' Print the document, set the background to false
        ' The print operation will run synchronusly
        oWordDoc.PrintOut False
    Else
        ' Test for a destination directory
        If DestinationDir = "PrintOnly" Then
            ' Error
            Err.Raise 1 + vbObjectError, "SaveAsDoc", "No destionation directory was entered."
        End If
        ' Test for a backlslash "\" at the end of the destination dir
        strLastChar = Mid(DestinationDir, Len(DestinationDir), Len(DestinationDir))
        If strLastChar <> "\" Then
            ' Not found append backslash
            DestinationDir = DestinationDir & "\"
        End If
        ' Build the drawing issue sheet file name according to the naming convention
        ' DIS & WorkOrder & .doc
        ' Save the document to the destination directory
        ' Set the read only property to false
        oWordDoc.SaveAs DestinationDir & "DIS" & WorkOrder & ".doc", , , , , , False
    End If
    ' Close the document
    oWordDoc.Close 0 ' Do not prompt for save dialog, already saved unless printing
    ' Quit word
    oWord.Quit
    ' Release objects
    rs.Close
    Set rs = Nothing
    Set oWord = Nothing
    Set oWordDoc = Nothing
    Set oRng = Nothing
    Set oTable = Nothing
    ' Return 0
    SaveAsDOC = 0

    Exit Function

ErrorHandler:

    ' Capture error
    lError = Err.Number
    strError = Err.Description
    On Error Resume Next
    ' Ensure the word app has quit
    oWord.Quit
    ' Release objects
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
        Set oWord = Nothing
        Set oWordDoc = Nothing
        Set oRng = Nothing
        Set oTable = Nothing
    End If
    ' Return error
    SaveAsDOC = lError
    ' Log error only
    ClassError lError, strError, "SaveAsDOC"

End Function


Larry Asher

Larry,

Thank You for your reply. It helped alot. I was able to successfully create the program I was trying to create, so far.
This has been a great learning experience. I will probably have to reuse this code later because I am working on this project in bits and pieces. I found also an article on msdn that teaches you how to utilize macros to get code to be converted easily into vb once the msword library is loaded.
Do you know how to clear multiple text boxes. I figure the command for one is an empty string?
Thank You
Aaron

I am glad to be able to assist you. I know the "pains" of learning currently I am beginning an adventure in Visual C++, it is a humbling experience.

If you want to clear multiple text boxes there may be several option available to you. If you used a control array you can simply use a For Next loop.

Dim intX as Integer

' This is one way
For intX = 1 to 4
   txtTextBox(intX).Text = ""
Next intX

' This is more dynamic
For intX = txtTextBox.LBound to txtText.UBound
     txtTextBox(intX).Text = ""
Next intX

If you have not created a control array you could also use a collection object with a For Each loop.

' Assume your form is named frmTest
Dim c As Control

For Each c In frmTest
     If TypeName(c) = "TextBox" Then
          c.Text = ""
     End
Next c

Or simply resort to the clearing the text boxes individually. If you find that you are clearing the same text boxes over and over again consider a Control Array, you can read up on it in the help files.
Another option would be to create a procedure that clears your text boxes. I use functions like this to initialize a form and reset it properties.

Private Sub ClearTextBoxes()

     txtTextBox1.Text = ""
     txtTextBox2.Text = ""
     txtTextBox3.Text = ""
     txtTextBox4.Text = ""
     ' Etc.

End Sub

Best of luck.

Larry Asher