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

x
?
Solved

Attach files to outgoing emails from within access

Posted on 2003-03-10
9
Medium Priority
?
922 Views
Last Modified: 2012-06-27
Access 97.

From within my database I can create emails and place them in outlook 98 outbox for sending.  I can also specify whether a specific file needs to be attached.  Unfortunately, I now need to be able to include one or many files, for example a couple of word documents, a spreadsheet and a powerpoint file.  Names and file types can be different each time.

Below is the code I currently use which sets in motion the email creation.

Private Sub cmdSendEmail_Click()
  On Error GoTo cmdSendEmail_ClickError
  Dim intreturned
  Dim Msg As String
 
  intreturned = MsgBox("Send e-mail to Warden selected.  If you continue," & Chr(13) & Chr(10) _
            & "1 e-mail messages will be queued for sending!", vbOKCancel + vbCritical + vbDefaultButton2, "Send E-mail")
 
    Select Case intreturned
    Case vbOK:
      If IsNull(Me.fraAttachment) Then
        SendMessage False
      Else
        If Me!fraAttachment = "1" Then
          SendMessage False, "c:\Resident\Notice.doc"
        End If
        If Me!fraAttachment = "2" Then
          SendMessage False, "c:\Resident\Notice.txt"
        End If
        If Me!fraAttachment = "3" Then
          SendMessage False
        End If
      End If
    Case vbCancel:
      Close
    Case Else
  End Select
 
cmdSendEmail_ClickExit:
  Exit Sub

cmdSendEmail_ClickError:
  MsgBox error$, 16, RSS
  Call errMonitor("ErrorHandler.errMonitor")
  Resume cmdSendEmail_ClickExit
End Sub
______________________


and an excerpt from the SendMessage function

Sub SendMessage(DisplayMsg As Boolean, Optional AttachmentPath)
  On Error GoTo SendMessageError
 
  Dim strDisplayText As String
  Dim objOutlook As Outlook.Application
  Dim objOutlookMsg As Outlook.MailItem
  Dim objOutlookRecip As Outlook.Recipient
  Dim objOutlookAttach As Outlook.Attachment
  Dim dbs As Database, rst As Recordset

further dims here but not relevant ....

  Set objOutlook = CreateObject("Outlook.Application")
  Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
               
                With objOutlookMsg
                ' Add the To recipient(s) to the message.
     
                Set objOutlookRecip = .Recipients.Add(rstW!Email)
                objOutlookRecip.Type = olTo
                .Subject = [txtSubject]

                    If Not IsMissing(AttachmentPath) Then
                        Set objOutlookAttach = .Attachments.Add(AttachmentPath)
                    End If

                    ' Should we display the message before sending?
                    If DisplayMsg Then
                        .Display
                    Else
                        .Send
                    End If


I have excluded a lot of the code from within the SendMessage function because it is not relevant and is very long.

So the guts of the question.  I need to be able to retrieve any number of files (could be doc, xls, ppt or others) from C:\RESIDENT\ and attach them to the outgoing email.  One thought is that a listbox shows the contents of c:\resident and some sort of loop goes thru the listbox attaching each of the files in turn to the email being created.

Any suggestions ??  Very grateful for any solutions that can be provided!!

thanks
joslad



0
Comment
Question by:joslad
  • 3
  • 2
  • 2
  • +2
9 Comments
 
LVL 2

Author Comment

by:joslad
ID: 8108322
A further clarification.  On my form that is used to initiate creation of the email, is a frame with three options.  1 specifies that a word document is to be attached, 2 a text file and 3 no files.

That will now need to consist of only two options.  1 - attach all files in C:\Resident and 2 attach no files.

cheers
0
 
LVL 10

Expert Comment

by:apollois
ID: 8108447
Hi joslad,

>>>One thought is that a listbox shows the contents of c:\resident and some sort
>>>of loop goes thru the listbox attaching each of the files in turn to the email
>>>being created.

Looks like you have a viable solution.  The only thing I could suggest is to create a zip file of all the attachments.

You can use FileSystemObject to get a list of files for the listbox.

What do you need help with?

Best Regards,
apollois
0
 
LVL 8

Expert Comment

by:dovholuk
ID: 8108453
you could try this... it simply searches the directory specified (put the const at the top of the module) and then builds your mail message and attaches each item...

enjoy... i think it does what you want...

dovholuk



'**************************** START COPY '****************************
Const PATH_TO_LOOK_IN As String = "C:\"

Function AttachFiles()

    Dim i As Long
    Dim mi As Object
    Dim out As Object

Set out = CreateObject("outlook.application")
Set mi = out.createitem(0)

With Application.FileSearch
    .LookIn = PATH_TO_LOOK_IN
    .FileName = "*.*"
    .Execute
   
    For i = 1 To .FoundFiles.Count
        mi.attachments.Add .FoundFiles(i)
    Next i
End With

mi.display

Set out = Nothing
Set mi = Nothing

End Function
'**************************** END COPY '****************************
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 2

Author Comment

by:joslad
ID: 8108648
Dovholuk

I am looking for something that can be implemented within the structure of the two existing bits of code above.

What changes would need to be made to the existing code.  there is a lot of additional code in the SendMessage function that builds up the text of each email.

thanks
joslad
0
 
LVL 41

Expert Comment

by:shanesuebsahakarn
ID: 8108654
Modify the SendMessage function like this:
Sub SendMessage(DisplayMsg As Boolean, AttachmentPath() As String)
Dim I As Long

And instead of:
If Not IsMissing(AttachmentPath) Then
   Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If

Put:
For I = 0 To UBound(AttachmentPath())
   If AttachmentPath(I)<>"" Then
      .Attachments.Add strAttachmentPath(I)
   End If
Next I

You can now pass an array of attachments as the second parameter. If you don't want any attachments, just pass an array with 1 element with an empty string. For example:

Dim Attchments(2) As String

Attachments(0)="C:\MySpreadsheet.xls"
Attachments(1)="C:\MyWordDoc.doc"
Attachments(2)="C:\MyPDF.pdf"
SendMessage(False,Attachments())
0
 
LVL 8

Accepted Solution

by:
dovholuk earned 2000 total points
ID: 8108780
well you'd mentioned that you already have a method of attaching one file... i've just extended it to include the entire directory of "c:\resident\" (and i note that i didn't include the "resident" part in my code... oi)

how to include it in what you already have?

just change this:
If Not IsMissing(AttachmentPath) Then
     Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If

to this:
With Application.FileSearch
   .LookIn = PATH_TO_LOOK_IN
   .FileName = "*.*"
   .Execute
   
   For i = 1 To .FoundFiles.Count
       objOutlookMsg.attachments.Add .FoundFiles(i)
   Next i
End With

that's all there is to it.

hope that makes sense. if not, let us know...

dovholuk
0
 
LVL 26

Expert Comment

by:Alan Warren
ID: 8108966
Have you considered putting the attachments in a network Share or web Share and sending a link. Less overhead.

MailFormatMime
BodyFormatHTML

Just a thought

Alan

0
 
LVL 26

Expert Comment

by:Alan Warren
ID: 8109006
joslad

useHyperlinks

Source: http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnout98/html/msdn_movs105.asp
Automating Microsoft Outlook 98
Mindy Martin



   Sub useHyperlinks()
    Dim ol As New Outlook.Application
    Dim ns As Outlook.NameSpace
    Dim newMail As Outlook.MailItem

    Set ns = ol.GetNamespace("MAPI")

    'Create a new mail message item.
    Set newMail = ol.CreateItem(olMailItem)
    With newMail
        .Subject = "Trainer Information for October 1997"

        'Create some body text with a hyperlink.
        .Body = "Here is the training information you requested:" _
            & vbCrLf & "<file://training/trainer info.xls>"

        With .Recipients.Add("mindym@imginc.com")
            .Type = olTo
            If Not .Resolve Then
                MsgBox "Unable to resolve address.", vbInformation
                Exit Sub
            End If
        End With

        'Send the mail message.
        .Send
    End With

    'Release memory.
    Set ol = Nothing
    Set ns = Nothing
    Set newMail = Nothing
End Sub


Alan

0
 
LVL 2

Author Comment

by:joslad
ID: 8116038
cheers dovholuk, your suggestion works really well.  I very much appreciate your help and the suggestions made by others.  Many thanks

regards
joslad
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Code that checks the QuickBooks schema table for non-updateable fields and then disables those controls on a form so users don't try to update them.
When we develop an application in Ms Access 2016 we should also try to protect the queries, macros and table links. I know I may not have a permanent solution but for novice users, they will not manage to break your application. Below is the detail …
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…
How can you see what you are working on when you want to see it while you to save a copy? Add a "Save As" icon to the Quick Access Toolbar, or QAT. That way, when you save a copy of a query, form, report, or other object you are modifying, you…
Suggested Courses

564 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