Help help with email function

Russ9517

Registered User.
Local time
Today, 05:58
Joined
Sep 15, 2006
Messages
30
i'm writing a function to send an email with the option of attachements
This is the code i'm using, it works fine but i need to be able to sne mulitple attachments. What would be the best way of doing this?

Thanks

code:
Public Function SendEmail(strTo As String, strSubject As String, strBody As String, Optional strCC As String, Optional strAttached As String)
Dim olkapps As Outlook.Application
Dim olknamespaces As Outlook.Namespace
Dim objmailitems As Outlook.MailItem
Set olkapps = New Outlook.Application
Set olknamespaces = GetNamespace("MAPI")
Set objmailitems = olkapps.CreateItem(olMailItem)
With objmailitems
.To = strTo
If IsNull(strCC) = False Then
.CC = strCC
End If
.Subject = strSubject
.Body = strBody
If IsNull(strAttached) = False Then
.Attachments.Add strAttached
End If
.Send
End With
Set objmailitems = Nothing
Set olknamespaces = Nothing
Set olkapps = Nothing
End Function
 
Last edited:
How do you pass strAttached to the function? If you pass it using a delimiter to separate individual attachments, then you could do something like this:
Code:
Dim varAttachments as Variant
Dim intCount as Integer
...clipped for brevity

With objmailitems
.To = strTo
If IsNull(strCC) = False Then
.CC = strCC
End If
.Subject = strSubject
.Body = strBody
If IsNull(strAttached) = False Then
    If InStr(1, strAttached, "|", vbTextCompare) > 0 Then
    varAttached = Split(strAttached, "|", , vbTextCompare)
       If UBound(varAttached)>0 Then
          Do until intCount = UBound(varAttached)+1
               .Attachments.Add varAttached(intCount)
               intCount = intCount + 1
          Loop
       End If
     Else
.Attachments.Add strAttached
       End If
End If

I had to come back to edit it as it posted accidentally before I was finished. I accidentally hit the tab and then the spacebar which posted it. :D
 
Last edited:
Thanks

Thanks alot it worked great
 
hai
I need the clarification for Common Dialog Control in Ms-Access.
am doing the Ms-Access application, in this application, i need to send and receive email. Now am doing the send mail, it's working fine. But the attachment is not working. Am using the coding for send mail as follows

Dim mess_body As String
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)

Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
.BodyFormat = olFormatRichText
' .SenderEmailAddress = From_Address
.To = Me.Email_Address

If (Cc_Address.Value = Null) Then
'MsgBox "CC Address field does not contain any E-mail Address"
Else
.CC = Me.Cc_Address
End If


If (Bcc_Address.Value = Null) Then
'MsgBox "BCC Address field does not contain any E-mail Address"
Else
.BCC = Me.Bcc_Address
End If


.Subject = Me.Mess_Subject
.HTMLBody = Me.mess_text
' .Attachments = Mail_Attachment_Path
If Left(Me.Mail_Attachment_Path, 1) <> "<" Then
.Attachments.Add (Me.Mail_Attachment_Path)
End If
'.DeleteAfterSubmit = True 'This would let Outlook send th note without storing it in your sent bin
.Send
End With
'MsgBox MailOutLook.Body
Exit Sub
email_error:
MsgBox "An error was encountered." & vbCrLf & "The error message is: " & Err.Description

Resume Error_out
Error_out:

In this code the attachment file path working as, we enter the file path manually, i need the browse button to browse the file, and the selected file path was stored in a text box.

This type of attachment i need it. I know the Common Dialog Control doing this. But if i were go to the Ms-Acces form toolbox. The common dialog control is not visible. Then i click the more controls button, and i select the Microsoft Common Dialog Control, version 6.0 and put it into the Ms-Access form. One error message wa displayed.
The error message is.

you don't have the license required to use this ActiveX control.
you tried to open a form c ontaining an OLE object or an ActiveX control or you tried to create an ActiveX control. To obtain the appropriate license, contact the company that provides the licensed OLE object or ActiveX control.

Then i go and try to register the ActiveX control. But again i have the error message.

c:\windows\system32\comctl32.dlll was loaded, but the DllRegisterServer entry point was not found.
This file can not be registered.

This error message was displayed. So that i have stucked.

Anybody can know, how to solve this problem. please let me know.


Thanks
Tamilvanan
 
you don't have the license required to use this ActiveX control.
you tried to open a form c ontaining an OLE object or an ActiveX control or you tried to create an ActiveX control. To obtain the appropriate license, contact the company that provides the licensed OLE object or ActiveX control.

Then i go and try to register the ActiveX control. But again i have the error message.

c:\windows\system32\comctl32.dlll was loaded, but the DllRegisterServer entry point was not found.
This file can not be registered.

You need to use the API instead of the control. To use the control you must have a license to use it (Developer's edition, or full VB), but the API you can use without having to have one of those.

Check out the sample database here
http://www.access-programmers.co.uk/forums/showthread.php?t=97638

You will need to import the module basCommonDialog from this sample and then call it using the code you will see behind the common dialog sample button.
 
Another one Problem Araise...

Thanks Alot!
It's worked Great!!

But another one problem raised. If i will put this file in another one system, it won't be work. I has to attach the file, but the mail was not to sent. It hang's up.
Am using the following code for Send mail and Attachmail was following.


Send Email
Private Sub Command20_Click()

Dim mess_body As String
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)

Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
.BodyFormat = olFormatRichText
.To = Me.Email_Address
.Subject = Me.Mess_Subject
.HTMLBody = Me.Mess_Text
If Left(Me.Mail_Attachment_Path, 1) <> "<" Then
.Attachments.Add (Me.Mail_Attachment_Path)
End If
'.DeleteAfterSubmit = True 'This would let Outlook send th note without storing it in your sent bin
.Send
End With
'MsgBox MailOutLook.Body
Exit Sub
email_error:
MsgBox "An error was encountered." & vbCrLf & "The error message is: " & Err.Description
Resume Error_out
Error_out:
End Sub


For attachment am using the following code.

Attachment
Private Sub Command55_Click()

Dim strPath As String

'Make a search string for the type of file you want to select

'Examples:
'Excel Files & All Files... CDSearchString = MakeFilterString("Excel Files (*.xls)", "*.xls", "All Files (*.*)", "*.*")
'Word Files... CDSearchString = MakeFilterString("Word Documents (*.doc)", "*.doc", "Text Files (*.txt)", "*.txt", "All Files (*.*)", "*.*")
'Graphic Files... CDSearchString = MakeFilterString("Graphic Files (*.bmp;*.gif;*.jpg;*.wmf)", "*.bmp;*.gif;*.jpg;*.wmf")

CDSearchString = MakeFilterString("All Files (*.*)", "*.*")

'Set the Caption on the Dialog Box
CDCaption = "Select File to Attach..."

If IsNull([Mail_Attachment_Path]) Or Me.Mail_Attachment_Path = "" Then
CDInitDir = "C:\"
Else
CDInitDir = [Mail_Attachment_Path]
End If

strPath = LaunchCD(Me)
If Not strPath = "None Selected" Then
Me.Mail_Attachment_Path = strPath
End If

End Sub
This can be need for any component? or we go to set any properties?.

I don't know why this problem raised. If anybody know how to solve this problem, please let me know.

Thanks
Tamilvanan
 

Users who are viewing this thread

Back
Top Bottom