Text Box To Word Doc

  • Thread starter Thread starter eschlep via AccessMonster.com
  • Start date Start date
E

eschlep via AccessMonster.com

I have a form that has a command button that prints the form as a report. I
would like to add a text box to the form that if nothing is in the text box
nothing happens but if something is in the text box i would like it to
automatically save the contents as a word doc when i click the command button.
I would also like it to prompt me for a file name to save the word doc. How
can i accomplish this. Thanks
 
The VBA function SendStringToWordFile() at the end of this message will
save a VBA string to a Word document. It seems to work properly but
hasn't been tested in all likely situations.

You can prompt the user for the name and location of the file with the
code at http://www.mvps.org/access/api/api0001.htm

I have a form that has a command button that prints the form as a report. I
would like to add a text box to the form that if nothing is in the text box
nothing happens but if something is in the text box i would like it to
automatically save the contents as a word doc when i click the command button.
I would also like it to prompt me for a file name to save the word doc. How
can i accomplish this. Thanks
Click to expand...



Public Function SendStringToWordFile( _
FileName As String, _
S As String,
Optional Overwrite As Boolean = True) As Long

'Creates or opens a Word document and appends a string to its
'contents.
'Overwrite controls what happens if the document already exists.
'Returns 0 on success, an error code otherwise.
'Not properly tested yet: use with caution


Dim oWord As Object 'Word.Application
Dim oDoc As Object 'Word.Document
Dim WordIsMine As Boolean

On Error Resume Next
Set oWord = GetObject(, "Word.Application")
On Error GoTo ErrHandler:
If oWord Is Nothing Then
Set oWord = CreateObject("Word.Application")
WordIsMine = True
Else
WordIsMine = False
End If

If Len(Dir(FileName)) > 0 Then 'document exists
If Overwrite Then 'delete it and create a new one
Kill FileName
Set oDoc = oWord.Documents.Add
Else 'open it ready to append new text
Set oDoc = oWord.Documents.Open(FileName)
End If
Else 'document does not already exist
Set oDoc = oWord.Documents.Add
End If

With oDoc.Range
If .Characters.Count > 1 Then 'document is not empty
.InsertParagraphAfter
End If
.InsertAfter S
End With

oDoc.SaveAs FileName

SendStringToWordFile = 0 'success

NormalExit:
If Not (oWord Is Nothing) Then
If WordIsMine Then
oWord.Quit False 'do not save changes
Else
oDoc.Close False
End If
End If
Exit Function

ErrHandler:
SendStringToWordFile = Err.Number
Resume NormalExit:

End Function
 
Could you explain how to use this code a little more. Where to put it, what
file names have to be changed in it and how link it to the text box that has
the text in it. Thanks
 
Paste the code from http://www.mvps.org/access/api/api0001.htm and the
function I posted into a new (standard) module in your database. Save
the module (let's call it vbToWord).

Then add something like this in the Click event procedure of your
button. This is untested air code:

Dim strFileName As String
Dim strFilter As String
Dim S As String
Dim lngResult As Long

'Get contents of textbox
'Nz ensures that if the textbox is empty S will be
'a zero-length string.
S = Nz(Me.txtXXX.Value, "")

If Len(S) > 0 Then 'Textbox is not empty
'Display the Save As dialog
strFilter = ahtAddFilterItem(strFilter, _
"Word documents (*.doc)", "*.XLS")
strFileName = ahtCommonFileOpenSave( _
Filter:=strFilter, OpenFile:=False, _
DialogTitle:="Specify destination file...", _
Flags:=ahtOFN_HIDEREADONLY)

If len(strFilename) > 0 Then
'User has supplied a filename
'Write textbox contents to Word
lngResult = SendStringToWordFile( _
strFileName, S)

If lngResult <> 0 Then
MsgBox "Something went wrong: Error " & lngResult _
& vbCrLF & Error(lngResult), vbExclamation + vbOkOnly
End If
Else
'User clicked Cancel: do nothing
End If
End If
 
Back
Top