Visual Basic > Windows and Controls

Send the text in a range to a word document

Send the text in a range to a word document

The following routine sends the text in a range to a word document:

'Purpose     :  Sends the text in a range to a word application
'Inputs      :  rngSelection                The range to send to a word document
'Outputs     :  Returns True on success.


Function WordSendRangeTo(rngSelection As Object, Optional sSaveToFile As String, Optional bShowWord As Boolean = False) As Boolean
    Dim oWordApp As Object          'Early bound type = Word.Application
    Dim oNewDoc As Object           'Early bound type = Word.Document
    Dim oWordRange As Object        'Early bound type = Word.Range
    Dim avVaules As Variant, vCell As Variant, sText As String
    
    On Error GoTo ErrFailed
    'Build up text to send to word document
    avVaules = rngSelection.Value
    For Each vCell In avVaules
        sText = sText & vCell & " "
    Next
    sText = Trim$(sText)
    
    'Create word objects
    Set oWordApp = CreateObject("Word.Application")
    Set oNewDoc = oWordApp.Documents.Add
    Set oWordRange = oNewDoc.Words(1)
    
    'Send text to word document
    With oWordRange
        .Text = sText
        On Error Resume Next
        Set .Font = rngSelection.Font
    End With
    On Error GoTo ErrFailed
    
    'Save Document
    If Len(sSaveToFile) Then
        oNewDoc.SaveAs sSaveToFile
    End If
    
    If bShowWord Then
        'Show Word
        oWordApp.Visible = True
        oWordApp.WindowState = 1    'wdWindowStateMaximize
    Else
        'Quit word
        oWordApp.Quit
    End If
    
    WordSendRangeTo = True
    GoTo ExitSub
    
ErrFailed:
    'Error occurred
    WordSendRangeTo = False
    
ExitSub:
    'De-reference objects
    Set oWordApp = Nothing
    Set oNewDoc = Nothing
    Set oWordRange = Nothing
End Function

'Demonstration routine
Sub Test()
    WordSendRangeTo Selection, "C:\test.doc"
End Sub