Record Set based on Query and Where Condition

[micarl@gmail.com]

I'm trying to two two things through Access to Outlook based on a
query and selections made on a form.

Firstly, i'd like to create an email based on the selections made on a
form.

Secondly i'd like to Export contact to Outlooks Contacts based on
selections.

The code i have so far for these is as follows:-

BCC Email:
Private Sub BCCEmail_Click( )
On Error GoTo Err_BCCMail_Cli ck

Dim stDocName As String
Dim MyOutlook As New Outlook.Applica tion
Dim MyMail As Outlook.MailIte m
Dim StrBCC As String
Dim rst As DAO.Recordset
Dim varItem As Variant
Dim strDescrip As String
Dim lngLen As Long
Dim strDelim As String
Dim strCategorySele ct As String
Dim strCountrySelec t As String
Dim strWhere As String

stDocName = "Q_Email"


With Me.CategorySele ct
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strCategorySele ct = strCategorySele ct &
strCategorySele ct & strDelim & .ItemData(varIt em) & strDelim & ","
strDescrip = strDescrip & """" & .Column(1, varItem)
& """, "
End If
Next
End With

lngLen = Len(strCategory Select) - 1
If lngLen 0 Then
strCategorySele ct = "[CategoryID] IN (" & Left$
(strCategorySel ect, lngLen) & ")"
lngLen = Len(strDescrip) - 2
If lngLen 0 Then
strDescrip = "Categories : " & Left$(strDescri p, lngLen)
End If
End If



With Me.CountrySelec t
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strCountrySelec t = strCountrySelec t & strCountrySelec t
& strDelim & .ItemData(varIt em) & strDelim & ","
strDescrip = strDescrip & """" & .Column(1, varItem)
& """, "
End If
Next
End With

lngLen = Len(strCountryS elect) - 1
If lngLen 0 Then
strCountrySelec t = "[CountryID] IN (" & Left$
(strCountrySele ct, lngLen) & ")"
lngLen = Len(strDescrip) - 2
If lngLen 0 Then
strDescrip = "Categories : " & Left$(strDescri p, lngLen)
End If
End If

If strCategorySele ct "" Then strWhere = strWhere &
strCategorySele ct & " And "
If strCountrySelec t "" Then strWhere = strWhere &
strCountrySelec t & " And "
If strWhere "" Then strWhere = Left(strWhere, Len(strWhere)
- 5)


Set rst = CurrentDb.OpenR ecordset(stDocN ame, dbOpenForwardOn ly)
With rst
Do Until .EOF
StrBCC = StrBCC & ![EmailAddress] & ";"
..MoveNext
Loop
..Close
End With
StrBCC = Left(StrBCC, Len(StrBCC) - 1)

Set MyOutlook = New Outlook.Applica tion
Set MyMail = MyOutlook.Creat eItem(olMailIte m)
MyMail.BCC = StrBCC
MyMail.Display

Set MyOutlook = Nothing
Set rst = Nothing

Exit_BCCMail_Cl ick:
Exit Sub

Err_BCCMail_Cli ck:
MsgBox Err.Description
Resume Exit_BCCMail_Cl ick

End Sub


Export Contacts:
Private Sub ExportToOutlook _Click()
On Error GoTo Err_ExportToOut look_Click

Dim stDocName As String
Dim dbs As Database
Dim rst As Recordset
Dim objOutlook As Outlook.Applica tion
Dim nms As Outlook.NameSpa ce
Dim flds As Outlook.Folders
Dim fldContacts As Object
Dim itms As Object
Dim itm As Object
Dim strTitle As String
Dim strFirstName As String
Dim strMiddleName As String
Dim strLastName As String
Dim strJobTitle As String
Dim strLastNameFirs t As String
Dim strBusinessStre et As String
Dim strBusinessStre et2 As String
Dim strBusinessCity As String
Dim strBusinessStat e As String
Dim strBusinessPost alCode As String
Dim strBusinessCoun try As String
Dim strBusinessPhon e As String
Dim strBusinessFax As String
Dim strHomePhone As String
Dim strOtherPhone As String
Dim strEMailAddress As String
Dim strEMailAddress 2 As String
Dim strWebPage As String
Dim strNotes As String
Dim strContactID As String
Dim strCRLF As String
Dim lngCount As Long


stDocName = "Q_ExportToOutl ook"

strCRLF = Chr$(13) & Chr$(10)

Set objOutlook = CreateObject("O utlook.Applicat ion")
Set nms = objOutlook.GetN amespace("MAPI" )
Set fldContacts = nms.GetDefaultF older(olFolderC ontacts)
Set itms = fldContacts.Ite ms

Set dbs = CurrentDb
Set rst = dbs![tblPerson].OpenRecordset( dbOpenTable, dbDenyRead)
lngCount = rst.RecordCount
MsgBox lngCount & " records to transfer to Outlook"

Do Until rst.EOF
With rst

strContactID = Nz(![PersonID])
strTitle = Nz(![Title])
strFirstName = Nz(![FirstName])
strLastName = Nz(![LastName])
strJobTitle = Nz(![JobTitle])
strLastNameFirs t = Nz(![LastName]) & ", " & Nz(![FirstName])
strBusinessStre et = Nz(![BusinessStreet]) & IIf(Nz(!
[BusinessStreet2]) <"", strCRLF & Nz(![BusinessStreet2]), "")
strBusinessCity = Nz(![BusinessCity])
strBusinessStat e = Nz(![BusinessState])
strBusinessPost alCode = Nz(![BusinessPostalC ode])
strBusinessCoun try = Nz(![BusinessCountry])
strBusinessPhon e = Nz(![BusinessPhone])
strBusinessFax = Nz(![BusinessFax])
strHomePhone = Nz(![HomePhone])
strHomeFax = Nz(![HomeFax])
strOtherPhone = Nz(![BusinessPhone2])
strOtherFax = Nz(![OtherFax])
strEMailAddress = Nz(![EmailAddress])
strEMailAddress 2 = Nz(![Email2Address])
strWebPage = Nz(![WebPage])
strNotes = Nz(![Notes])
End With

Set itm = itms.Add("IPM.C ontact")

With itm
.Title = strTitle
.FirstName = strFirstName
.MiddleName = strMiddleName
.LastName = strLastName
.JobTitle = strJobTitle
.BusinessAddres sStreet = strBusinessStre et
.BusinessAddres sCity = strBusinessCity
.BusinessAddres sState = strBusinessStat e
.BusinessAddres sPostalCode = strBusinessPost alCode
.BusinessAddres sCountry = strBusinessCoun try
.BusinessTeleph oneNumber = strBusinessPhon e
.BusinessFaxNum ber = strBusinessFax
.HomeTelephoneN umber = strHomePhone
.HomeFaxNumber = strHomeFax
.OtherTelephone Number = strOtherPhone
.OtherFaxNumber = strOtherFax
.Email1Address = strEMailAddress
.Email2Address = strEMailAddress 2
.WebPage = strWebPage
.Notes = strNotes
.Categories = "From Access"
.Close (olSave)
Me![txtLastContact] = strContactID & " -- " &
strLastNameFirs t

DoCmd.DoMenuIte m acFormBar, stDocName, acNormal,
acRecordsMenu, acSaveRecord, , acMenuVer70

End With
rst.MoveNext
Loop

MsgBox "All Contacts exported!"

Exit_ExportToOu tlook_Click:
Exit Sub

Err_ExportToOut look_Click:
MsgBox Err.Description
Resume Exit_ExportToOu tlook_Click

End Sub

At the moment i have the Query set up to filter this data from the
form, but it may be easiest to create a Where Condition so that i can
export the different selections to different folders?

Any help would be superb!