Userform to set up contact, create folder, and select template to send an email

[UncleWiggy]

Hi,
I am pretty good at Excel VBA, should I say I use it lots in a nieve way. Record, then change to suit. So now I want to do the same with Outlook, and cant ! No record. Ahhhhh
Ok so help needed here please guys ( and gals?)
An enquiry arrives. (via phone, email of verbally) I want a macro to open up a userform, from Outlook ribbon.
Create New contact, enter the contacts name, email, phone number.
Then create a folder in the inbox ready for all sent and received emails using the name, already inputted (eg. Inbox/leads/NameSurname) Check quick check first incase it exists first)
then with that done, depending on the type of enquiry, I want to select via a check box, 1,2 or 3 emails templates to be sent to this new contact, automatically when I press a send button to close the user form.

Simple? I imaging it is for the experienced. I am sure I would get there with code snippets form all over and a few months trial and error however it has probably already been invented a hundreds of times,...!

Your able assistance or guidance would be most welcomed and of course I will buy a beer in MY local as a thank you !

Many thanks in anticipation of a flood of replys....
Barry (aka Uncle Wiggy)

[JP2112]

This will create a new contact and let you fill in the details. Then it tries to create a folder based on the name. For the rest, I charge :)


Sub NewCode()
Dim contact As Outlook.ContactItem
Dim folder As Outlook.Folder
Dim fullName As String
Set contact = Outlook.CreateItem(olContactItem)
contact.Display
fullName = contact.fullName
If Not CheckForFolder(fullName) Then
Set folder = CreateSubFolder(fullName)
End If
End Sub

Function CheckForFolder(strFolder As String) As Boolean
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olInbox As Outlook.Folder
Dim FolderToCheck As Outlook.Folder
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olInbox = olNS.GetDefaultFolder(olFolderInbox).Folders("leads")
' try to set an object reference to specified folder
On Error Resume Next
Set FolderToCheck = olInbox.Folders(strFolder)
On Error GoTo 0
CheckForFolder = (Not FolderToCheck Is Nothing)
End Function
Function CreateSubFolder(strFolder As String) As Outlook.MAPIFolder
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim folder As Outlook.Folder
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set folder = olNS.GetDefaultFolder(olFolderInbox).Folders("leads")
Set CreateSubFolder = folder.Folders.Add(strFolder)
End Function