Sending document through email

  • Thread starter Thread starter Lodewijk Olthof
  • Start date Start date
L

Lodewijk Olthof

I have a from called frmDocuments. On this form I have te fields cboFilename
and txtCompleteFilename. The field cboFilename holds the name of a file on
my computer (say '2003048') and the field txtCompleteFilename say were the
specific file is located on my computer (say 'P:\letters\2003\').

In the same database I have a table called tblMembers and in that table i
have a field called txtEmail.

Now I want to make a button on the form frmDocument that, when clicked, the
document in cboFilename is mailed to all the txtEmail adresses. What code
should I have behind the button?
 
This only works for MS-Outlook (not Lotus Notes)... Have slightly changed
the code, so you may want to check it, but the basics are what I use in a
number of apps and it works fine...

Private Sub Command1_Click()
On Error Resume Next

Dim slOutlook As Object
Dim slNamespace As Object
Dim slFolder As Object
Dim slMessage As Object

If Dir(txtCompleteFilename & cboFileName) = "" Then
MsgBox "File not found"
Exit Sub
End If
If Not ConnectToOutlook(slOutlook, slNamespace, slFolder) Then
MsgBox "Error Connecting to Outlook"
Exit Sub
End If

Set slMessage = slOutlook.CreateItem(0)
With slMessage
.Subject = "My Document"
.To = BuildEMailList
.Attachments.Add (txtCompleteFilename & cboFileName)
.Send
End With

slMessage.Close
Set slMessage = Nothing
slFolder.Close
Set slFolder = Nothing
slNamespace.Close
Set slNamespace = Nothing
slOutlook.Close
Set slOutlook = Nothing

MsgBox "Message Sent..."
End Function

Function BuildEMailList() As String
On Error Resume Next

Dim myRec As DAO.Recordset

BuildEMailList = ""
Set myRec = CurrentDB().OpenRecordset("SELECT * FROM tblMembers;")
myRec.MoveFirst
Do Until myRec.EOF
If Trim(BuildEMailList) = "" Then
BuildEMailList = BuildEMailList & myRec![txtEmail]
Else
BuildEMailList = BuileEMailList & ";" & myRec![txtEmail]
End If
myRec.MoveNext
Loop

myRec.Close
Set myRec = Nothing
End Sub

Function ConnectToOutlook(ByRef tmpObject As Object, _
ByRef tmpNameSpace As Object, _
ByRef tmpFolder As Object) As Boolean
On Error Resume Next

Err = 0
Set tmpObject = CreateObject("Outlook.Application")
Set tmpNameSpace = tmpObject.GetNameSpace("MAPI")
Set tmpFolder = tmpNameSpace.GetDefaultFolder(olFolderInbox)
If Err > 0 Or tmpObject Is Nothing Or _
tmpNameSpace Is Nothing Or _
tmpFolder Is Nothing Then
tOutlookActive = False
ConnectToOutlook = False
tmpFolder.Close
tmpNameSpace.Close
tmpObject.Close
Set tmpFolder = Nothing
Set tmpNameSpace = Nothing
Set tmpObject = Nothing
Exit Function
End If

tOutlookActive = True
ConnectToOutlook = True
CreateBackupFolder tmpFolder
End Function
 
Bugger... Just realised, that you need to remove a few lines (used this in a
project, so there are global variables that you don't need).
In the 'ConnectToOutlook' function, remove the folder object and references
to tmpFolder (the global constant olFolderInbox is not available in
MS-Access, it's a VB6 thing...). This also includes, the call to the connect
to outlook, so the command1_click event, you can remove the slFolder
variables. Also, remove the lines that refer to tOutlookActive (in the
connect to outlook function), as that was a global variable from my
project....


Ruskin Hardie said:
This only works for MS-Outlook (not Lotus Notes)... Have slightly changed
the code, so you may want to check it, but the basics are what I use in a
number of apps and it works fine...

Private Sub Command1_Click()
On Error Resume Next

Dim slOutlook As Object
Dim slNamespace As Object
Dim slFolder As Object
Dim slMessage As Object

If Dir(txtCompleteFilename & cboFileName) = "" Then
MsgBox "File not found"
Exit Sub
End If
If Not ConnectToOutlook(slOutlook, slNamespace, slFolder) Then
MsgBox "Error Connecting to Outlook"
Exit Sub
End If

Set slMessage = slOutlook.CreateItem(0)
With slMessage
.Subject = "My Document"
.To = BuildEMailList
.Attachments.Add (txtCompleteFilename & cboFileName)
.Send
End With

slMessage.Close
Set slMessage = Nothing
slFolder.Close
Set slFolder = Nothing
slNamespace.Close
Set slNamespace = Nothing
slOutlook.Close
Set slOutlook = Nothing

MsgBox "Message Sent..."
End Function

Function BuildEMailList() As String
On Error Resume Next

Dim myRec As DAO.Recordset

BuildEMailList = ""
Set myRec = CurrentDB().OpenRecordset("SELECT * FROM tblMembers;")
myRec.MoveFirst
Do Until myRec.EOF
If Trim(BuildEMailList) = "" Then
BuildEMailList = BuildEMailList & myRec![txtEmail]
Else
BuildEMailList = BuileEMailList & ";" & myRec![txtEmail]
End If
myRec.MoveNext
Loop

myRec.Close
Set myRec = Nothing
End Sub

Function ConnectToOutlook(ByRef tmpObject As Object, _
ByRef tmpNameSpace As Object, _
ByRef tmpFolder As Object) As Boolean
On Error Resume Next

Err = 0
Set tmpObject = CreateObject("Outlook.Application")
Set tmpNameSpace = tmpObject.GetNameSpace("MAPI")
Set tmpFolder = tmpNameSpace.GetDefaultFolder(olFolderInbox)
If Err > 0 Or tmpObject Is Nothing Or _
tmpNameSpace Is Nothing Or _
tmpFolder Is Nothing Then
tOutlookActive = False
ConnectToOutlook = False
tmpFolder.Close
tmpNameSpace.Close
tmpObject.Close
Set tmpFolder = Nothing
Set tmpNameSpace = Nothing
Set tmpObject = Nothing
Exit Function
End If

tOutlookActive = True
ConnectToOutlook = True
CreateBackupFolder tmpFolder
End Function


Lodewijk Olthof said:
I have a from called frmDocuments. On this form I have te fields cboFilename
and txtCompleteFilename. The field cboFilename holds the name of a file on
my computer (say '2003048') and the field txtCompleteFilename say were the
specific file is located on my computer (say 'P:\letters\2003\').

In the same database I have a table called tblMembers and in that table i
have a field called txtEmail.

Now I want to make a button on the form frmDocument that, when clicked, the
document in cboFilename is mailed to all the txtEmail adresses. What code
should I have behind the button?
Click to expand...
Click to expand...
 
Back
Top