Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 159
  • Last Modified:

Sending emails via a group

Hello All
I need to be able to send mails from my APP internally via exchange server and i have done this OK. Now the customer has seen that this is possible they want to expand on this a little and send to multiple people. I can set up groups such as sales and purchasing and have send mails like this from my APP, once again tested and all OK. Question is can i add users to exchange groups programatically/on the fly or do i need to do this manually before hand, I.E. add user a and user b to purchasing  or  can i select users from a list and write somthing to add them to a group

Hope that makes sense
0
bostonste
Asked:
bostonste
1 Solution
 
spprivateCommented:
Here is a code .
Courtesy

http://www.outlookcode.com/codedetail.aspx?id=636
Private Sub cmdAdd_Click()
On Error Resume Next
    
    Dim sysPath As String, sSrv As String, sFN As String, sOpenSTR As String
    Dim adoCon As New ADODB.Connection
    Dim adoRS As New ADODB.Recordset
    
    sysPath = App.Path
   
    sSrv = "R01" 'SQL production Database
   
 
    sFN = "Assoc"
 
    strFolderPath = "Public Folders\All Public Folders\" & sFN
    
    arrFolders() = Split(strFolderPath, "\")
    Set objApp = CreateObject("Outlook.Application")
    Set objNS = objApp.GetNamespace("MAPI")
    Set objFolder = objNS.Folders.Item(arrFolders(0))
        
    If Not objFolder Is Nothing Then
        For I = 1 To UBound(arrFolders)
            Set colFolders = objFolder.Folders
            Set objFolder = Nothing
            Set objFolder = colFolders.Item(arrFolders(I))
            If arrFolders(I) = sFN Then
                objFolder.ShowAsOutlookAB = True
                
                Set objDL = objFolder.Items.Add(Outlook.OlItemType.olDistributionListItem)
                objDL.DLName = sFN
                objDL.Save
 
                adoCon.ConnectionString = "driver={SQL Server};" & _
                               "server=" & sSrv & ";Trusted_Connection=Yes;database=RAS"
                If sFN = "Associates" Then
                    sOpenSTR = "'ASC'"
                Else
                    sOpenSTR = "'CR'"
                End If
 
 
                adoRS.Open "Exec RES_AddAssocOrCRS " & sOpenSTR, adoCon.ConnectionString, adOpenDynamic, adLockPessimistic
 
                If Not (adoRS.BOF And adoRS.EOF) Then
                    adoRS.MoveFirst
                    Do Until adoRS.EOF
                        Set objCI = objFolder.Items.Add(olContactItem)
 
                        With objCI
                            .FirstName = adoRS("Fname")
                            .LastName = adoRS("Lname")
                            .Email1Address = adoRS("Email_Address")
                            .Email1DisplayName = adoRS("Display_Name")
                            .SelectedMailingAddress = olHome
                            .Categories = sFN
                            .Save
                        End With
        
                        Set myMailItem = objApp.CreateItem(Outlook.OlItemType.olMailItem)
                        Set oRecipients = myMailItem.Recipients 'Resolve the current user just added by Email Address
                        oRecipients.Add (objCI.Email1Address) 'Add Contact Item as a recipient
                        oRecipients.ResolveAll
                        
                        objDL.AddMembers (oRecipients) ' if count > 109 - it bombs
                        objDL.Display
        
                        Set objCI = Nothing 'in next Iteration
                        Set oRecipients = Nothing 'Empty Contact Item and Recipient Item
            
 
                        adoRS.MoveNext
                    Loop
 
                End If
            End If
            
            If objFolder Is Nothing Then
                Exit For
            End If
        Next I
    End If
    
    Set objDL = Nothing
    
    Set adoRS = Nothing
    Close adoCon
    Set adoCon = Nothing
    Set objFolder = Nothing
    Set colFolders = Nothing
    Set objNS = Nothing
    Set objApp = Nothing
    Unload Me
End Sub

Open in new window

0
 
CodeCruiserCommented:
One options is to run a loop and add all the emails to the Recipients collection of the Message rather than first adding to the group.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Tackle projects and never again get stuck behind a technical roadblock.
Join Now