Link to home
Start Free TrialLog in
Avatar of Wills030998
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.errMonitor")
  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("tblEmails_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.Application")
  Do While Not rst.EOF
    ' Create the message.
    Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
   
    With objOutlookMsg
      ' Add the To recipient(s) to the message.
      'Set objOutlookRecip = .Recipients.Add(Me![txtemailaddress])
      Set objOutlookRecip = .Recipients.Add(rst.emailaddress)
     
      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(AttachmentPath)
      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.Value = 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.errMonitor")
  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
Avatar of vbWhiz
vbWhiz

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Wills030998
Wills030998

ASKER

VBwhiz

Perfect.  works a treat..

thanks
VBwhiz

Perfect.  works a treat..

thanks