Sending Word documents as e-mail from VB app

Hi

I've inherited an app at work. One of its tasks is to generate a Word mail merge (using Word 2000) and e-mail the resulting documents. Everything works fine but I'm scratching my head trying to work out how to add multiple attachments to each e-mail.

Wonder if anyone could suggest a solution?

Regards,

YaHozna.
YaHoznaAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

DangerizCommented:
Hi There,

I've written a similar app that sends email. Check the code for adding multiple attachments...

Dim MySession As Session
Dim Mymsg As Message
Dim Mymessagecol As Messages
Dim Myrecipscol As Recipients
Dim Myrecip As Recipient
Dim Myattcol As Attachments
Dim Myatt As Attachment

Set MySession = New Session
'first get a session my loggin onto MAPI/CDO
MySession.Logon , , True, True

Set Mymessagecol = MySession.Outbox.Messages
Set Mymsg = Mymessagecol.add
Mymsg.Subject = txtSubject.text
Mymsg.Text = txtText.text

Set Myrecipscol = Mymsg.Recipients
Set Myrecip = Myrecipscol.add

Myrecip.Name = txtName.text
Myrecip.Address = txtAddress.text
Myrecip.Type = CdoTo

Set Myattcol = Mymsg.Attachments
Set Myatt = Myattcol.add

Myatt.Name = txtAttach1.Text ' (file path)
Myatt.Type = CdoFileData    '1

' This is useful for faxing (email faxing)
Myatt.Source = txtAttach1.Text
Myatt.ReadFromFile (txtAttach1.Text)

'I wanted to test multiple attachemnts
'of different types so I added the text box and this code

'you can remm this out for a single attachment
'and in a real app use a commondialog each time to
'add as many attachments as you want

Set Myatt = Myattcol.Add
Myatt.Name = txtAttach2.Text
Myatt.Type = CdoFileData
Myatt.Source = txtAttach2.Text
Myatt.ReadFromFile txtAttach2.Text

Myrecip.Resolve

Mymsg.Update
Mymsg.Send showdialog:=False

MySession.Logoff

Set Mymsg = Nothing
Set Mymessagecol = Nothing
Set Myrecipscol = Nothing
Set Myrecip = Nothing
Set Myattcol = Nothing
Set Myatt = Nothing
Set MySession = Nothing

Hope this helps
0
YaHoznaAuthor Commented:
Hi Dangeriz. Er, not really. Perhaps I should flesh out the problem a bit.

The app in question is generating a mail merge using Word and Document objects and gives the user the option of printing, faxing or e-mailing the resulting documents. The documents, if e-mailed, are sent using Word Mail and are sent as an attachment to each e-mail recipient.

I can't seem to figure out how to add a (pre-selelected probably) list of ancillary documents - e.g. images, PDFs, etc., as attachments to each e-mail along with the original merged document.

Regards,

Gordon.
0
DangerizCommented:
Hi

Can I please see the code that emails the original merged document?
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

YaHoznaAuthor Commented:
Hi Dangeriz. The merge and subsequent print/fax/email process is carried out by the procedure CreateLetter below:

Private Sub CreateLetter(ByVal strTemplate As String, ByVal strSQL As String, ByVal intSendMethod As Integer, ByVal intType As Integer)

    On Error GoTo ErrHandler

    Dim oWrd As Object
    Dim oDoc As Object
    Dim sFilename As String
    Dim strConn As String
    Dim intCurEnquiryID As Integer
    Dim intOverlayID As Integer
    Dim strSQL1 As String
    Dim strSQL2 As String
    Dim blnWordRunning As Boolean
   
   
   
   
    'Create Word and Document objects
    Set oWrd = StartApp("Word.Application")
    blnWordRunning = (oWrd.Documents.Count > 0)
    Set oDoc = oWrd.Documents.Add(strTemplate)
    strConn = GetConnStringForWord(oWrd.Version)
   
    strSQL1 = ""
    strSQL2 = ""
    If Len(strSQL) > 255 Then
        strSQL1 = Left(strSQL, 255)
        strSQL2 = Right(strSQL, Len(strSQL) - 255)
    Else
        strSQL1 = strSQL
    End If
   
    'Open data source and retrieve data
    Select Case Left(oWrd.Version, 3)
        Case "8.0", "9.0"  'office 97 or office 2000
            oDoc.MailMerge.OpenDataSource Name:="", ConfirmConversions:= _
                False, ReadOnly:=False, LinkToSource:=False, AddToRecentFiles:=False, _
                PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
                WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
                Connection:=strConn, _
                SQLStatement:=strSQL1, SQLStatement1:=strSQL2
       
        Case "10."  'office XP
            oDoc.MailMerge.OpenDataSource Name:=strAppPath & "\BBData.odc" _
                , ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
                AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
                WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
                Format:=wdOpenFormatAuto, Connection:= _
                "Provider=SQLOLEDB.1;Password=Enqpass;Persist Security Info=True;User ID=Enq;Initial Catalog=BBData;Data Source=138.248.16.3;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=BB05156" _
                , SQLStatement:=strSQL, SQLStatement1:=strSQL2
               
        Case Else
            MsgBox "Version " & oWrd.Version & " is not compatible with " & App.Title, vbCritical
            SetMouse Normal
            Exit Sub
    End Select
   
    With oWrd.Selection
        .WholeStory
        .Fields.Update 'update fields like total number of pages
        .HomeKey Unit:=wdStory ' go to beginning of document
    End With
   
    Select Case intSendMethod
        Case 1 'mail
       
        Case 2 'fax
       
        Case 3 'email
            With oWrd.ActiveDocument.MailMerge
                .Destination = wdSendToEmail
                .MailAsAttachment = True
                .MailAddressFieldName = "Email"
                .MailSubject = GetCurOverlayCompany & " Enquiry"
                .SuppressBlankLines = True
            End With
    End Select
   
    oWrd.Visible = True
    oWrd.Activate
   
    'Execute the merge
    If Me.OptionMerge(1).Value = True Then
        Select Case intSendMethod
            Case 1 'mail
                With oDoc.MailMerge
                    .Destination = wdSendToPrinter
                    .Execute True
                End With
                oDoc.Close False
               
            Case 2 'fax
           
            Case 3 'email
                oWrd.ActiveDocument.MailMerge.Execute True
        End Select
    End If
   
    If Me.OptionMerge(1).Value = True Then
       
    Else
        'If Selected to display Main Document instead of merging, then there can be
        'confusion: if there is more then one send method (mail, fax, email), then
        'it will not be clear which main document is for mail, which for faxing etc.
        'Therefore, save the document in the Temp folder using a name that
        'indicates the Send method
        Dim strFileName As String
        If intNoSendMethods > 1 Then
            If intSendMethod = 1 Then 'mail
                If intType = 1 Then 'Letter
                    strFileName = "Enquiry Letter Mail.doc"
                ElseIf intType = 2 Then 'Backsheets
                    strFileName = "Enquiry Backsheets Mail.doc"
                ElseIf intType = 3 Then 'Materials
                    strFileName = "Materials Mail.doc"
                ElseIf intType = 4 Then 'Amendment
                    strFileName = "Amendment Mail.doc"
                End If
            ElseIf intSendMethod = 2 Then 'fax
                If intType = 1 Then 'Letter
                    strFileName = "Enquiry Letter Fax.doc"
                ElseIf intType = 2 Then 'Backsheets
                    strFileName = "Enquiry Backsheets Fax.doc"
                ElseIf intType = 3 Then 'Materials
                    strFileName = "Materials Fax.doc"
                ElseIf intType = 4 Then 'Amendment
                    strFileName = "Amendment Fax.doc"
                End If
            ElseIf intSendMethod = 3 Then 'Email
                If intType = 1 Then 'Letter
                    strFileName = "Enquiry Letter Email.doc"
                ElseIf intType = 2 Then 'Backsheets
                    strFileName = "Enquiry Backsheets Email.doc"
                ElseIf intType = 3 Then 'Materials
                    strFileName = "Materials Email.doc"
                ElseIf intType = 4 Then 'Amendment
                    strFileName = "Amendment Email.doc"
                End If
            End If
            oDoc.SaveAs FileName:=Chr(34) & strTempFolder & "\" & strFileName & Chr(34)
        End If
    End If
   
    'Run the WinFax macro if mergin to fax
    If intSendMethod = 2 Then
        oWrd.Run MacroName:="Merge_to_Winfax"
    End If
   
    'Close down any documents created by the application and Word itself if not previously
    'opened.
    On Error GoTo CleanExit
    If Me.OptionMerge(1).Value And intSendMethod = 3 Then
        'E-mail
        oWrd.ActiveDocument.Close SaveChanges:=False
    End If
   
    If Not blnWordRunning Then
        oWrd.Quit
    End If
   
CleanExit:
    Set oDoc = Nothing
    Set oWrd = Nothing
    Exit Sub
   
ErrHandler:
    If gf_DispError(gf_Location(m_strFORM_NAME, "CreateLetter"), vbInformation + vbRetryCancel) = vbRetry Then
        Resume
    Else
        Resume CleanExit
    End If
           
End Sub
0
DangerizCommented:
Sorry, your guess is as good as mine....
0
DanRollinsCommented:
YaHozna, an EE Moderator will handle this for you.
Moderator, my recommended disposition is:

    Refund points and save as a 0-pt PAQ.

DanRollins -- EE database cleanup volunteer
0
ChmodCommented:
As recommended

Chmod
Community Support Moderator @Experts Exchange
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.