automation import contacts

Hi,
I'm trying to import contacts to a contacts subfolder using a VBA macro. Trouble is they keep importing into the main contacts folder rather than the sub folder. Below is what i have(modified  from MS KB 170320).

Any help much appreciated...

Sub ImportContacts()
'Set up DAO Objects:
   Dim oDataBase As Object
   Dim rst As Object
   Set oDataBase = OpenDatabase _
     ("C:\Email.mdb")
   Set rst = oDataBase.OpenRecordset("Email")

   'Set up Outlook Objects:
   Dim olns As Object              ' Outlook Namespace
   Dim Contacts As Object       ' Main Contact Folder
   Dim cf As Object                 ' Contact folder
   Dim c As Object                  ' Contact Item
   Dim Prop As Object             ' User property
   Dim ol As New Outlook.Application
   Set olns = ol.GetNamespace("MAPI")
   Set Contacts = olns.GetDefaultFolder(olFolderContacts)
   Set cf = Contacts.Folders("Staff")

   With rst
      .MoveFirst
      ' Loop through the Access records
      Do While Not .EOF
         ' Create a new Contact item
         Set c = ol.CreateItem(olContactItem)
         ' Specify which Outlook form to use:
         ' Change "IPM.Contact" to "IPM.Contact.<formname>" if you've
         ' created a custom Contact form in Outlook.
         c.MessageClass = "IPM.Contact"
         ' Create all built-in Outlook fields
         If ![Staffname] <> "" Then c.FullName = ![Staffname]
         If ![Staff_Email] <> "" Then c.Email1Address = ![Staff_Email]
         ' Save the contact
         c.Save
         .MoveNext
      Loop
   End With
End Sub