Solved

attach word document to email by a 'send' button

Posted on 2001-06-19
14
445 Views
Last Modified: 2008-02-01
Hi
I have a "send" button inside a ms word 97 document which will attach this word document to my MS Outlook as a new message.
The problem is, after the coding using VB code, it can only attached the document, and nothing more. However I would like the "Recipients", "Subject" and "body" to be hard coded too.

pls advise, i am using the 'activedocument' object currently.

thanks
0
Comment
Question by:xtine
14 Comments
 
LVL 1

Expert Comment

by:KhrisE
ID: 6206344
listening ....
0
 
LVL 6

Accepted Solution

by:
blakeh1 earned 20 total points
ID: 6206544
Here is a function to automate sending of an Outlook message, just provide the arguments.
If using multiple recipients yoiu must pass in as an array

Function Send_OutlookMsg(Optional ByVal sSendTo As Variant, _
                            Optional ByVal sSubject As String, _
                            Optional ByVal sBodyText As String, _
                            Optional ByVal sAttachment) As Long
    '********************************************************************
    'All arguments are optional
    'sSendTo should be passed in as an array of strings(or variant array)
    'for multiple recipients or if only using 1 recipient as a string
    '********************************************************************
    Dim i As Integer
    Dim appOutl As Object 'outlook.Application object
    Dim ns As Object 'Outlook.NameSpace object
    Dim maiMail As Object
   
    On Error GoTo err_Send_OutlookMsg
    'The boolean variable is optional,dim only if you will be using it
    'Dim boorecip As Boolean

    Set appOutl = CreateObject("Outlook.Application")
    'use the following lines to automatically log on to
    'Outlook, may not be needed, or desired depending on users
    'setup. Comment out if not needed.
    '****************************************
    Set ns = appOutl.GetNamespace("MAPI")
    'provide the profilename, if no password leave blank
    ns.Logon "Blake Hartman", , False, True
    '*****************************************
    Set maiMail = appOutl.CreateItem(0) 'equivalent of Outlook constant olmailitem
    With maiMail
        If Not IsMissing(sSubject) Then .Subject = sSubject
        If Not IsMissing(sBodyText) Then .body = sBodyText
        If Not IsMissing(sAttachment) Then .Attachments.Add sAttachment
        If Not IsMissing(sSendTo) Then
            If VarType(sSendTo) = 8200 Or VarType(sSendTo) = 8204 Then
                'there are multiple recipients
                'if it is an array of strings vbString + VbArray or 82000
                'or it is an array of variant type vbVariant + vbArray or 8204
                For i = LBound(sSendTo) To UBound(sSendTo)
                    If sSendTo(i) <> "" Then .Recipients.Add sSendTo(i)
                Next
            Else
                'It should just be one recipient
                If VarType(sSendTo) = vbString Then .Recipients.Add sSendTo
            End If
        End If
        'Optional test against addressbook is
        ' boorecip = .Recipients.ResolveAll
        'You might want to insert a conditinal here if boorecip=False
        'If Not IsMissing(sSendTo) Or boorecip = True Then
        If Not IsMissing(sSendTo) Then
            .Send
            'Use .Send instead of .Display to send the msg without displaying it
            '.Display
        Else
            'message must be displayed because they have not added
            'any recipients
            .Display
        End If
       
    End With
    Send_OutlookMsg = 0
exit_Send_OutlookMsg:
    On Error Resume Next
    Set maiMail = Nothing
    Set appOutl = Nothing
    Set ns = Nothing
    Exit Function
err_Send_OutlookMsg:
    Send_OutlookMsg = Err.Number
    MsgBox "[" & Err.Number & "] " & Err.Description
    Resume exit_Send_OutlookMsg
End Function


here is how you would call the routine from your document

Sub x2()
    Dim myarray(0 To 1)
    ActiveDocument.SaveAs "C:\data\word97\doc1.doc"
    myarray(0) = "Mary Smith"
    myarray(1) = "Joe Smith"
    Send_OutlookMsg myarray(), "This is the subject", "This is the Body part", ActiveDocument.FullName
End Sub
0
 
LVL 1

Expert Comment

by:KhrisE
ID: 6209947
blakeh1 - Excellent in my view ... pity I was not awarding the points.. tell me how to attach multiple attachments ... and how to determine if a user has modified a document being sent (so you can ask the user if they want to save it before it is sent or maybe save it to a temporary file and then delete it) and I'll post 100 points for collection by you

KhrisE
0
 
LVL 6

Expert Comment

by:blakeh1
ID: 6210337
To attach multiple attachments you can use the same idea as the recipients, by passing it in as an array, then loop thru the array and use the .Attachments.Add  method to add each one.

You can test if a file has been modified by checking .Saved property on the Document Close event (or use an AutoClose macro, if it is false then something has been changed since when it was opened. You will also have to trap the save event and ask if they want to send it, because if they. Also trapping the save event by using AutoSave or FileSave/FileSaveAs macro or Document Save event, this would allow you to save the file as a different name and close the original untouched.  
0
 
LVL 1

Expert Comment

by:KhrisE
ID: 6210425
yes you've got the idea ... now a small code sample will seel the deal then I get to put out......and your the receiver - do you like em blond, thin and of couse the big bits ???
0
 
LVL 6

Expert Comment

by:blakeh1
ID: 6210464
Here are the macros to create in the document, these will trap the events and prompt to send

Sub SendTheDoc()
    Dim myarray(0 To 1)
    ActiveDocument.SaveAs "C:\data\word97\doc1.doc"
    myarray(0) = "Mary Smith"
    myarray(1) = "Joe Smith"
    Send_OutlookMsg myarray(), "test", "The Body part", ActiveDocument.FullName
End Sub

Sub FileSave()
    Dim x As Long
    x = MsgBox("Do you want to send this new copy?", vbYesNo)
    If x = vbYes Then
        SendTheDoc
    Else
    End If
    ActiveDocument.Save
    'can also use a save as to save as a different name
End Sub
Sub FileSaveAs()
    Dim x As Long
    x = MsgBox("Do you want to send this new copy?", vbYesNo)
    If x = vbYes Then
        SendTheDoc
    Else
    End If
   
    ActiveDocument.SaveAs
End Sub
Sub FileClose()
    Dim x As Long
    If ActiveDocument.Saved = False Then
        'a change was made
        x = MsgBox("Do you want to send this new copy?", vbYesNo)
        If x = vbYes Then
            SendTheDoc
        Else
        End If
    Else
    End If
    ActiveDocument.Close
End Sub
0
 
LVL 6

Expert Comment

by:blakeh1
ID: 6210469
sure
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 1

Expert Comment

by:KhrisE
ID: 6210497
how would I guessed that.... I'll put out now
0
 
LVL 6

Expert Comment

by:blakeh1
ID: 6210528
here is the whole thing with the fucntion modified to take multiple attachments. Also I changed the order of when the doc was saved( should be saved before calling the routine in FileSave and FileSaveas)

Sub SendTheDoc()
    Dim myarray(0 To 1)
    Dim vAttachments(0 To 1)
    'not needed if trapping events
    'ActiveDocument.Save
    myarray(0) = "Mary Smith"
    myarray(1) = "Joe Smith"
    vAttachments(0) = ActiveDocument.FullName
    vAttachments(1) = "C:\data\word97\02.doc"
    Send_OutlookMsg myarray(), "test", "The Body part", vAttachments()
End Sub
Sub FileSave()
    Dim x As Long
    'can also use a save as to save as a different name
    ActiveDocument.Save
    x = MsgBox("Do you want to send this new copy?", vbYesNo)
    If x = vbYes Then
        SendTheDoc
    Else
    End If
End Sub
Sub FileSaveAs()
    Dim x As Long
    ActiveDocument.SaveAs
    x = MsgBox("Do you want to send this new copy?", vbYesNo)
    If x = vbYes Then
        SendTheDoc
    Else
    End If
   
   
End Sub
Sub FileClose()
    Dim x As Long
    If ActiveDocument.Saved = False Then
        'a change was made
        x = MsgBox("Do you want to send this new copy?", vbYesNo)
        If x = vbYes Then
            SendTheDoc
        Else
        End If
    Else
    End If
    ActiveDocument.Close
End Sub
Function Send_OutlookMsg(Optional ByVal sSendTo As Variant, _
                            Optional ByVal sSubject As String, _
                            Optional ByVal sBodyText As String, _
                            Optional ByVal sAttachment As Variant) As Long
    '********************************************************************
    'All arguments are optional
    'sSendTo should be passed in as an array of strings(or variant array)
    'for multiple recipients or if only using 1 recipient as a string
    '********************************************************************
    Dim i As Integer
    Dim appOutl As Object 'outlook.Application object
    Dim ns As Object 'Outlook.NameSpace object
    Dim maiMail As Object
   
    On Error GoTo err_Send_OutlookMsg
    'The boolean variable is optional,dim only if you will be using it
    'Dim boorecip As Boolean

    Set appOutl = CreateObject("Outlook.Application")
    'use the following 2 lines to automatically log on to
    'Outlook, may not be needed, or desired depending on users
    'setup
    Set ns = appOutl.GetNamespace("MAPI")
    'provide the profilename, if no password leave blank
    ns.Logon "Blake Hartman", , False, True
   
    Set maiMail = appOutl.CreateItem(0) 'equivalent of Outlook constant olmailitem
    With maiMail
        If Not IsMissing(sSubject) Then .Subject = sSubject
        If Not IsMissing(sBodyText) Then .body = sBodyText
        If Not IsMissing(sAttachment) Then
            If VarType(sAttachment) = 8200 Or VarType(sAttachment) = 8204 Then
                'there are multiple recipients
                'if it is an array of strings vbString + VbArray or 8200
                'or it is an array of variant type vbVariant + vbArray or 8204
                For i = LBound(sAttachment) To UBound(sAttachment)
                    If sAttachment(i) <> "" Then .Attachments.Add sAttachment(i)
                Next
            Else
                'It should just be one recipient
                If VarType(sSendTo) = vbString Then .Recipients.Add sSendTo
            End If
        End If
        If Not IsMissing(sSendTo) Then
            If VarType(sSendTo) = 8200 Or VarType(sSendTo) = 8204 Then
                'there are multiple recipients
                'if it is an array of strings vbString + VbArray or 82000
                'or it is an array of variant type vbVariant + vbArray or 8204
                For i = LBound(sSendTo) To UBound(sSendTo)
                    If sSendTo(i) <> "" Then .Recipients.Add sSendTo(i)
                Next
            Else
                'It should just be one recipient
                If VarType(sSendTo) = vbString Then .Recipients.Add sSendTo
            End If
        End If
        'Optional test against addressbook is
        ' boorecip = .Recipients.ResolveAll
        'You might want to insert a conditinal here if boorecip=False
        'If Not IsMissing(sSendTo) Or boorecip = True Then
        If Not IsMissing(sSendTo) Then
            .Send
            'Use .Send instead of .Display to send the msg without displaying it
            '.Display
        Else
            'message must be displayed because they have not added
            'any recipients
            .Display
        End If
       
    End With
    Send_OutlookMsg = 0
exit_Send_OutlookMsg:
    On Error Resume Next
    Set maiMail = Nothing
    Set appOutl = Nothing
    Set ns = Nothing
    Exit Function
err_Send_OutlookMsg:
    Send_OutlookMsg = Err.Number
    MsgBox "[" & Err.Number & "] " & Err.Description
    Resume exit_Send_OutlookMsg
End Function
0
 
LVL 1

Expert Comment

by:KhrisE
ID: 6210587
you're the best tonite - I've now really put out the points are yours

Now about the other 250 - can you help with that question ?? Its really important to me that one :-|

0
 

Author Comment

by:xtine
ID: 6211101
Thanks blakeh1 !
Your answer has given me an idea of implementing it together with my existing codes.
0
 
LVL 1

Expert Comment

by:KhrisE
ID: 6214312
Blake1 - is there anyway it can simply pickup  the default profile - as in your code it appears that it hard to be hard coded

KhrisE
0
 
LVL 6

Expert Comment

by:blakeh1
ID: 6214493
if you comment out the lines

   Set ns = appOutl.GetNamespace("MAPI")
   'provide the profilename, if no password leave blank
   ns.Logon "Blake Hartman", , False, True

that should use the default
0
 

Expert Comment

by:drcarty
ID: 12626550
This is great, but I have one quesiotn. I am using this with a document that will be filled out multiple times. I'd like to save the files on the senders computer without replacing the previous one. How can I modify the script to either allow for the sender to change the save as file name or even better use a form field in the doucment such as "Name" as the file name?
0

Featured Post

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
Change data on Excel Graph from dropdown 4 49
Change of cell color 5 42
excel forecast function 1 29
Windows 10 Modified 2 30
Introduction Perhaps more familiar to developers who primarily use VBScript than to developers who tend to work only with Microsoft Office and Visual Basic for Applications (VBA), the Dictionary is a powerful and versatile class, and is useful …
Some time ago I was asked to create a VBA function that would calculate a check digit for an input number, using the following procedure: First, sum up all the individual digits in the number If that sum value has more than one digit, then sum up …
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now