Wills030998
asked on
Convert the following Access code to Visual Basic
I know very little about VB, but am trying to duplicate a process that I currently do in Access, in Visual Basic 5.
The following code needs to be converted to run under VB.
Private Sub cmdSendEmail_Click()
On Error GoTo cmdSendEmail_ClickError
Dim xemail As Integer
Dim intreturned
Dim Msg As String
xemail = DCount("[EmailID]", "[tblEmails_to_go]")
intreturned = MsgBox("Send e-mail selected. If you continue," & Chr(13) & Chr(10) _
& xemail & " e-mail messages will be queued for sending!", vbOKCancel + vbQuestion + 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.e rrMonitor" )
Resume cmdSendEmail_ClickExit
End Sub
Sub SendMessage(DisplayMsg As Boolean, Optional AttachmentPath)
On Error GoTo SendMessageError
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
Dim counter
If IsNull(Me.txtSubject) Then
MsgBox "You must enter a subject before despatching e-mails!"
Me.txtSubject.SetFocus
Exit Sub
End If
If IsNull(Me.txtNotice) Then
MsgBox "You must enter text before despatching e-mail!"
Me.txtNotice.SetFocus
Exit Sub
End If
' Return reference to current database.
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblEmai ls_to_go")
' Populate Recordset object.
rst.MoveLast
' Return to first record.
'progress meter form code follows - down to next remark
'and then further towards bottom
DoCmd.OpenForm ("frmProgress")
DoEvents
Dim f As Form
Set f = Forms!frmprogress
f!prog.Max = rst.RecordCount
'progress meter form code above
rst.MoveFirst
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Appl ication")
Do While Not rst.EOF
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMa ilItem)
With objOutlookMsg
' Add the To recipient(s) to the message.
'Set objOutlookRecip = .Recipients.Add(Me![txtema iladdress] )
Set objOutlookRecip = .Recipients.Add(rst.emaila ddress)
objOutlookRecip.Type = olTo
' Set the Subject, Body, and Importance of the message.
.Subject = [txtSubject]
.Body = [txtNotice]
.Importance = olImportanceHigh 'High importance
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(Attachmen tPath)
End If
' Should we display the message before sending?
If DisplayMsg Then
.Display
Else
.Send
End If
End With
counter = counter + 1
'progress meter code follows "down to next remark
'and then a little further down too
Forms!frmprogress.prog.Val ue = counter
'progress meter code above
rst.MoveNext
Loop
Set objOutlook = Nothing
'progress meter code below
DoCmd.Close acForm, "frmProgress"
'progress meter code above and ends here
MsgBox "" & counter & " e-mail messages have been placed in your outbox!"
rst.Close
Set dbs = Nothing
SendMessageExit:
Exit Sub
SendMessageError:
MsgBox error$, 16, RSS
Call errMonitor("ErrorHandler.e rrMonitor" )
Resume SendMessageExit
End Sub
From an access form, a command button is clicked and individual email messages are sent to all my contacts. I can attach files if necessary. What I would like to do is include this process from within visual basic.
I have attempted this and can create the forms etc, but have no end of problems trying to run it.
thanks.
The following code needs to be converted to run under VB.
Private Sub cmdSendEmail_Click()
On Error GoTo cmdSendEmail_ClickError
Dim xemail As Integer
Dim intreturned
Dim Msg As String
xemail = DCount("[EmailID]", "[tblEmails_to_go]")
intreturned = MsgBox("Send e-mail selected. If you continue," & Chr(13) & Chr(10) _
& xemail & " e-mail messages will be queued for sending!", vbOKCancel + vbQuestion + 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.e
Resume cmdSendEmail_ClickExit
End Sub
Sub SendMessage(DisplayMsg As Boolean, Optional AttachmentPath)
On Error GoTo SendMessageError
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
Dim counter
If IsNull(Me.txtSubject) Then
MsgBox "You must enter a subject before despatching e-mails!"
Me.txtSubject.SetFocus
Exit Sub
End If
If IsNull(Me.txtNotice) Then
MsgBox "You must enter text before despatching e-mail!"
Me.txtNotice.SetFocus
Exit Sub
End If
' Return reference to current database.
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblEmai
' Populate Recordset object.
rst.MoveLast
' Return to first record.
'progress meter form code follows - down to next remark
'and then further towards bottom
DoCmd.OpenForm ("frmProgress")
DoEvents
Dim f As Form
Set f = Forms!frmprogress
f!prog.Max = rst.RecordCount
'progress meter form code above
rst.MoveFirst
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Appl
Do While Not rst.EOF
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMa
With objOutlookMsg
' Add the To recipient(s) to the message.
'Set objOutlookRecip = .Recipients.Add(Me![txtema
Set objOutlookRecip = .Recipients.Add(rst.emaila
objOutlookRecip.Type = olTo
' Set the Subject, Body, and Importance of the message.
.Subject = [txtSubject]
.Body = [txtNotice]
.Importance = olImportanceHigh 'High importance
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(Attachmen
End If
' Should we display the message before sending?
If DisplayMsg Then
.Display
Else
.Send
End If
End With
counter = counter + 1
'progress meter code follows "down to next remark
'and then a little further down too
Forms!frmprogress.prog.Val
'progress meter code above
rst.MoveNext
Loop
Set objOutlook = Nothing
'progress meter code below
DoCmd.Close acForm, "frmProgress"
'progress meter code above and ends here
MsgBox "" & counter & " e-mail messages have been placed in your outbox!"
rst.Close
Set dbs = Nothing
SendMessageExit:
Exit Sub
SendMessageError:
MsgBox error$, 16, RSS
Call errMonitor("ErrorHandler.e
Resume SendMessageExit
End Sub
From an access form, a command button is clicked and individual email messages are sent to all my contacts. I can attach files if necessary. What I would like to do is include this process from within visual basic.
I have attempted this and can create the forms etc, but have no end of problems trying to run it.
thanks.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
VBwhiz
Perfect. works a treat..
thanks
Perfect. works a treat..
thanks
ASKER
Perfect. works a treat..
thanks