Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 201
  • Last Modified:

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.
0
YaHozna
Asked:
YaHozna
1 Solution
 
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
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
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

Featured Post

[Webinar On Demand] Database Backup and Recovery

Does your company store data on premises, off site, in the cloud, or a combination of these? If you answered “yes”, you need a data backup recovery plan that fits each and every platform. Watch now as as Percona teaches us how to build agile data backup recovery plan.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now