Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Solved

Convert the following Access code to Visual Basic

Posted on 1998-11-10
3
214 Views
Last Modified: 2013-11-25
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.
0
Comment
Question by:Wills030998
  • 2
3 Comments
 
LVL 3

Accepted Solution

by:
vbWhiz earned 300 total points
ID: 1444251
Here's My attempt. In case you don't know you will need to add two references to your VB project Microsoft Data Access Objects(DAO) and Microsoft Outlook Object Library. You will also need to create the two forms and add their respective controls. You can paste the code into your form.

Here is my interpretation of your VB/access code:


Private dbs As Database
Private rst As Recordset


Private Sub cmdSendEmail_Click()
    'I remmed out the error handler because I don't have the RSS constant
    'or the errMonitor Sub
    'On Error GoTo cmdSendEmail_ClickError
   
    Dim xemail As Integer
    Dim intreturned
    Dim Msg As String
   
    ' Return reference to current database.
    '+++++++++++ Replace the path to the mdb with the true path +++++++
    Set dbs = DBEngine.Workspaces(0).OpenDatabase("C:\My Documents\db2.mdb")
    Set rst = dbs.OpenRecordset("tblEmails_to_go")
   
    'The DCount Function Doesn't exist in VB - That's why we
    'Set the rst before beginning the email routine
    'It's good to check if there are records before moving to the last one
    If (rst.BOF And rst.EOF) Then Exit Sub
   
    ' Populate Recordset object.
    rst.MoveLast
   
    xemail = rst.recordcount
   
   
    'This should all look pretty familiar
    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:
            'always dots (.) not bangs (!) for control references
            'VB textboxes never contain the value Null so we check len instead
            If Len(Me.fraAttachment) = 0 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

'I remmed out the error handling stuff because I don't have a sub errMonitor
'or a const RSS
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 counter
   
    'No nulls again and dots not bangs
    If Len(Me.txtSubject.Text) = 0 Then
        MsgBox "You must enter a subject before despatching e-mails!"
        Me.txtSubject.SetFocus
        Exit Sub
    End If
   
    If Len(Me.txtNotice.Text) = 0 Then
        MsgBox "You must enter text before despatching e-mail!"
        Me.txtNotice.SetFocus
        Exit Sub
    End If
   
    'The opening of the recordset got pushed up to the click event
    'otherwise this should be familiar
 
     rst.MoveLast
    'progress meter form code follows - down to next remark
    'and then further towards bottom
   
    ' .Show rather than DoCmd, I love VB!
    frmProgress.Show
    Dim f As frmProgress
    Set f = 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 = Me.txtSubject.Text
            .Body = Me.txtNotice.Text
            .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
        f.Prog.Value = counter
        'progress meter code above
         
        rst.MoveNext
    Loop
    Set objOutlook = Nothing
   
    'progress meter code below
    Unload f
    'progress meter code above and ends here
     
    MsgBox "" & counter & " e-mail messages have been placed in your outbox!"
    rst.Close
   
SendMessageExit:
    Exit Sub

SendMessageError:
    'MsgBox Error$, 16, RSS
    'Call errMonitor("ErrorHandler.errMonitor")
    'Resume SendMessageExit
End Sub






I hope this works for you!


0
 

Author Comment

by:Wills030998
ID: 1444252
VBwhiz

Perfect.  works a treat..

thanks
0
 

Author Comment

by:Wills030998
ID: 1444253
VBwhiz

Perfect.  works a treat..

thanks
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

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

Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

808 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