OK, here you go.
This routine assumes you have a contacts folder in Outlook named CurrentNL.
UpRider

option explicit
dim intMsgBox as Integer
'---------------------------------------------------------------------------------------
' Procedure : subExportToOutlookCurrentNL
' DateTime  : 2/8/2006 18:40
' Author    : David
' Purpose   : Use Office Automation to directly add contacts to Outlook
contact folder "CurrentNL"
'---------------------------------------------------------------------------------------
'
Sub subExportToOutlookCurrentNL(qQuery As String)
   'empty CurrentNL first
   Call subDeleteCurrentNLContacts
   If intMsgBox = vbCancel Then Exit Sub
   Dim intMemCount As Long
   Dim intEmailCount As Long
   Dim db As DAO.Database
   Dim olNs As Outlook.NameSpace    ' Outlook Namespace
   Dim cf As Outlook.MAPIFolder     ' Contact folder
   Dim C As Object                  ' Contact Item
   Dim ol As New Outlook.Application
   Dim outNLContacts As Outlook.MAPIFolder
   On Error GoTo Err_subExportToOutlookCurrentNL
   Set db = CurrentDb()
   Set olNs = ol.GetNamespace("MAPI")
   Set cf = olNs.GetDefaultFolder(olFolderContacts)
   Set outNLContacts = cf.Folders.Item(1)
   Call subEmailExpand(qQuery)
   intMemCount = DCount("*", qQuery) 'number of memberships getting email
   intEmailCount = DCount("*", "tblworkEmail") 'number of email addresses
getting email
   swcancel = False
   intMsgBox = MsgBox("This selection will export " + str(intEmailCount) +
" email addresses " _
   & "into Outlook contact folder CurrentNL " _
   & "for " + str(intMemCount) + " memberships.          " & vbCrLf _
   & "Clicking OK will not send email now.", _
   vbOKCancel, "     M E M B E R S   T O   P R O C E S S     ")
   If intMemCount = 0 Or intMsgBox = vbCancel Then
       Exit Sub
   End If
   Dim rst As DAO.Recordset
   Set rst = db.OpenRecordset("tblworkEmail")
   DoCmd.Hourglass True

   With rst
      .MoveFirst
       Do While Not .EOF
           Set C = outNLContacts.Items.Add
           C.MessageClass = "IPM.Contact.frmContactNL"
           If Len(![FIRST] & vbNullString) > 0 Then C.FirstName = ![FIRST]
           If Len(![me_mail1] & vbNullString) > 0 Then C.Email1Address =
![me_mail1]
           If Len(![LAST] & vbNullString) > 0 Then C.LastName = ![LAST]
           If Len(![NLMO] & vbNullString) > 0 Then C.User1 = ![NLMO]
           C.Save
           .MoveNext
       Loop
   End With
   DoCmd.Hourglass False
   MsgBox "Export/Import to Outlook completed. You may switch to Outlook
now and mail merge the " _
       & "contacts in folder CurrentNL an email.       ", vbOKOnly, "     T
R A N S F E R  D O N E     "
   Dim strAppendDate As String
   Dim strFolder As String
   Dim strFileName As String
   strFolder = fcnGetSetupData(29)
   strAppendDate = "_" & Month(Date) & "_" & Day(Date) & "_" & Year(Date)
   strFileName = strFolder & glbEmailExportName & "_Opt1Direct_on" &
strAppendDate & ".txt"

   DoCmd.TransferText acExportDelim, , "tblworkEmail", strFileName, True

subExportToOutlookCurrentNL_Exit:
   DoCmd.Hourglass False
   On Error Resume Next
   rst.Close
   Set rst = Nothing
   'db.Close
   Set db = Nothing
   Set C = Nothing
   Set outNLContacts = Nothing
   Set olNs = Nothing
   'ol.Quit
   Set ol = Nothing
   Exit Sub
Err_subExportToOutlookCurrentNL:
   Call fcnLogError(Err.Number, Err.Description,
"subExportToOutlookCurrentNL of basDBTCModules", , True)
   Resume subExportToOutlookCurrentNL_Exit
End Sub

Private Sub subDeleteCurrentNLContacts()
   Dim appOutlook As Outlook.Application
   'Dim appOutlook As Object
   Dim myNS As Outlook.NameSpace
   Dim myFolder As Outlook.MAPIFolder
   Dim myTargetFolder As Outlook.MAPIFolder
   Dim myItems As Items
   Dim X As Integer

   On Error GoTo subDeleteCurrentNLContacts_Error

   Set appOutlook = CreateObject("Outlook.Application")
   Set myNS = appOutlook.GetNamespace("MAPI")
   Set myFolder = myNS.GetDefaultFolder(olFolderContacts)
   Set myTargetFolder = myFolder.Folders("CurrentNL")
   Set myItems = myTargetFolder.Items

   intMsgBox = MsgBox("CurrentNL now contains " &
myTargetFolder.Items.Count & " items " _
       & "(Probably last month's email list)." _
       & vbCrLf & "Do you want to empty the CurrentNL folder before the
export?     ", vbYesNoCancel, _
   "           D E L E T E   T H E   C O N T A C T S          ")
   If intMsgBox = vbYes Then
       For X = myItems.Count To 1 Step -1
           myItems(X).Delete
       Next X
   End If

subDeleteCurrentNLContacts_Exit:
   On Error Resume Next
   Set myNS = Nothing
   Set myFolder = Nothing
   Set myItems = Nothing
   Set myTargetFolder = Nothing
   Set appOutlook = Nothing
   Exit Sub
subDeleteCurrentNLContacts_Error:
   Call fcnLogError(Err.Number, Err.Description, "Procedure
subDeleteCurrentNLContacts" & " of basMailProcessing", , True)
   Resume subDeleteCurrentNLContacts_Exit
End Sub

'---------------------------------------------------------------------------------------
' Procedure : subEmailExpand
' DateTime  : 7/9/2004 16:45
' Author    : David
' Purpose   : Populate tblworkEmail with all email addresses in the query.
If more than one email address
'           : is in a member's record, it will be expanded to 2 (or more)
records in tblworkEmail
'---------------------------------------------------------------------------------------
'
Sub subEmailExpand(qQuery)
   On Error GoTo subEmailExpand_Error
   Call fcnEmptyTable("tblworkEmail")
   Dim qdf As DAO.QueryDef
   Dim prm As DAO.Parameter
   Dim Qrst As DAO.Recordset
   Set qdf = CurrentDb.QueryDefs(qQuery)
   For Each prm In qdf.Parameters
       prm.Value = Eval(prm.Name)      'different for prompts
   Next prm
   Dim reccnt As Long
   Set Qrst = qdf.OpenRecordset()
   Dim Trst As DAO.Recordset
   Set Trst = CurrentDb.OpenRecordset("tblworkEmail")
   reccnt = 0
   'Qrst is input, Trst is output
   With Qrst
       .MoveFirst
       Do While Not .EOF
           Trst.AddNew

           Trst![LAST] = strconv(Qrst![LAST], vbProperCase)
           Trst!FIRST = fcnCleanFirst(Nz(Qrst!FIRST, " "))
           Trst!NLMO = Qrst!NLMO
           Trst.Update
       If Len(Qrst![memail2] & vbNullString) > 0 Then
           Trst.AddNew

         Trst![LAST] = strconv(Qrst![LAST], vbProperCase)
           Trst!FIRST = fcnCleanFirst(Qrst!FIRST)
           Trst!NLMO = Qrst!NLMO
           Trst.Update
       End If
           Qrst.MoveNext
       Loop
   End With

subEmailExpand_Exit:
   On Error Resume Next
   Trst.Close
   qdf.Close
   Set qdf = Nothing
   Set Trst = Nothing
   Exit Sub
subEmailExpand_Error:
   Call fcnLogError(Err.Number, Err.Description, "Procedure subEmailExpand"
& " of basMailProcessing", , True)
   Resume subEmailExpand_Exit
End Sub