MailMerge

Here is a response (coming from Dalin) :

1. in the general declaration area, add:

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long


Drop a text box to your form, call it txtTemplate
Drop another text box, call it txtMerge
Drop a command button, the name is command1

Paste these code to the form:

Private Sub Command1_Click()
     
    'declare variables
    Dim hHandle1 As Long
    Dim hHandle2 As Long
    Dim lLength As Long
    Dim sTempFile As String
    Dim sTemplateFile As String
    Dim sMergeFile As String
    Dim sDataFile As String
    Dim nFileNum As Integer
    Dim word As Object
    Dim sTempString As String
    Dim nLoopCount As Integer
     
    'find out if template exists
    On Error GoTo noFile
     
    'assign template file name
    lLength = 0
    sTempFile = App.Path & "\" & txtTemplate.Text
    lLength = FileLen(sTempFile)
    If lLength = 0 Then
        MsgBox "Template file does not exist!"
        Exit Sub
    Else
        sTemplateFile = sTempFile
    End If

    'assign merge file name
    sMergeFile = App.Path & "\" & txtMerge.Text
     
    'assign data file name
    sDataFile = App.Path & "\" & "DATA.TXT"
     
    On Error Resume Next
    'delete merge file
    Kill sMergeFile
     
    'delete data file
    Kill sDataFile

    On Error GoTo TrapError
   
    'open data file
    nFileNum = FreeFile
    Open sDataFile For Output As #nFileNum
     
    'write out first record
    sTempString = "John,Jones,Acme,123 Main Street,New York,NY,11221,Marketing Director,52000"
    sTempString = FillQuote(sTempString)
    Print #nFileNum, sTempString
     
    'write out second record
    sTempString = "Charles,Smith,Acme,456 Elm Way,New York,NY,11222,Sales Director,50000"
    sTempString = FillQuote(sTempString)
    Print #nFileNum, sTempString
     
    'close the file
    Close #nFileNum
     
    'change mouse
    Screen.MousePointer = vbHourglass
     
    'change caption
    Form1.Caption = "Running Microsoft Word..."
     
    'create word object
    Set word = CreateObject("Word.Basic")    'create a WordBasic object
     
    'find word
    hHandle1 = FindWindow(0&, "Microsoft Word")
     
    'show word
    hHandle2 = ShowWindow(hHandle1, 0)
     
    'change caption
    Me.Caption = "Opening Template..."
     
    'open the template
    word.fileopen sTemplateFile

    'open the data
    word.MailMergeOpenDataSource sDataFile
     
    'perform merge
    word.mailmergetodoc
     
    'change caption
    Me.Caption = "Saving New Document..."
     
    'save merge file
    word.filesaveas sMergeFile
     
    'close merge file
    word.Fileclose 2
     
    'change caption
    Me.Caption = "Opening Merged Document..."
     
    'open merge document
    word.fileopen sMergeFile
     
    'show merged document
    hHandle2 = ShowWindow(hHandle1, 1)

MergeExit:
    'change caption
    Me.Caption = "" 
     
    'change mouse
    Screen.MousePointer = vbDefault
    Exit Sub

TrapError:
    Select Case Err
        Case 53:    'file not found
            Resume Next
        Case Else:
            MsgBox "Error " & Err & " - " & Error
            DoEvents
            DoEvents
            If Not word Is Nothing Then     'clean up object
                Set word = Nothing
            End If
            Resume MergeExit
    End Select

    Exit Sub
noFile:
    Resume Next
     
End Sub

Function FillQuote(ByVal sTempString As String) As String
    'this function fills the string with double quotes around each field
     
    Dim nLoopCount As Integer
    Dim sFinalString As String
     
    For nLoopCount = 1 To Len(sTempString)
        If Mid$(sTempString, nLoopCount, 1) = "," Then
            sFinalString = sFinalString & Chr$(34) & "," & Chr$(34)
        Else
            sFinalString = sFinalString & Mid$(sTempString, nLoopCount, 1)
        End If
    Next nLoopCount
     
    sFinalString = Chr$(34) & sFinalString & Chr$(34)
    FillQuote = sFinalString
End Function

If I have a recordset of data that I want to display in my mailmerge document, how do I give a mailmerge field called "address" for example the address field from my resultset.

tomorrow i will suplly the code, i have done it and i have it in home PC. Here in my work Pc there is no VB

Tell me if you still need the piece of code

PedroG

If you have the code handy I would appreciate it if you could send it.

shaneom i'm sorry tha i've forgot it at home, but tomorrow i will post it here ok!

Tomorrow is fine