Although you can't save new contacts directly in the iCloud contacts folder unless you select the iCloud Contacts folder before opening the new Contact form, there are a couple of options available to move new contacts to the iCloud. First you can use the Move to Folder command instead of Save and Close. If you aren't familiar with the Move to folder command, instructions and a video tutorial are at Issues Syncing Outlook and iCloud Contacts.

The other option is a macro. Depending on how you typically create new contacts and if all new contacts belong in the iCloud, you can either use a macro to open a new contact form and set the Save to folder to the iCloud or use a macro that watches the default contacts folder and moves any new contacts to the iCloud. If you normally use the Add to Contacts option to create a contact for people who send you mail, there is a macro to mimic that feature too.

These macros aren't limited to just the iCloud. You can use them with any non-default contacts folder. You'll need to update the folder path though.

Either macro can easily be adapted for Calendars or Tasks.

Macro to Set the Save to Folder

If you mostly use the New Contact button when you need to save a new contact, this macro will work well for you. If you need to save some contacts to the default Contacts folder and some to the iCloud (or another contacts folder), you'll use this macro.

Paste the macro in a new Module then add it to the ribbon, next to the New items button, or Quick Access toolbar (QAT) for easy access.

Public Sub CreateContactiCloud()

 Dim objContact As Outlook.ContactItem
 Set contactFolder = GetFolderPath("icloud\contacts")
 Set objContact = contactFolder.Items.Add(olcontactItem)
 objContact.Display

 End Sub

 Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
     Dim oFolder As Outlook.Folder
     Dim FoldersArray As Variant
     Dim i As Integer
         
     On Error GoTo GetFolderPath_Error
     If Left(FolderPath, 2) = "\\" Then
         FolderPath = Right(FolderPath, Len(FolderPath) - 2)
     End If
     'Convert folderpath to array
     FoldersArray = Split(FolderPath, "\")
     Set oFolder = Application.Session.Folders.item(FoldersArray(0))
     If Not oFolder Is Nothing Then
         For i = 1 To UBound(FoldersArray, 1)
             Dim SubFolders As Outlook.Folders
             Set SubFolders = oFolder.Folders
             Set oFolder = SubFolders.item(FoldersArray(i))
             If oFolder Is Nothing Then
                 Set GetFolderPath = Nothing
             End If
         Next
     End If
     'Return the oFolder
     Set GetFolderPath = oFolder
     Exit Function
         
 GetFolderPath_Error:
     Set GetFolderPath = Nothing
     Exit Function
 End Function

Mimic 'Add to Contacts' Command

This version of the macro mimics the Add to Contacts command when you right-click on a sender's name in an email message. Add the macro to the ribbon or Quick Access Toolbar then select a message and run the macro.

This macro can be used in a module.

Sub CreateContactiCloud()
    Dim objContact As Outlook.ContactItem
    Dim objMail As Outlook.MailItem

Set objMail = Application.ActiveExplorer.Selection.Item(1)
 
 Set contactFolder = GetFolderPath("icloud\contacts")
 Set objContact = contactFolder.Items.Add(olContactItem)
    

With objContact
    .FullName = objMail.Sender
    .Email1Address = objMail.SenderEmailAddress
  
' if you want to add the selected email as an attachment 
    '.Attachments.Add objMail
   .Save
   .Display
End With
    
    Set objContact = Nothing
    Set objMail = Nothing
End Sub

 Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
     Dim oFolder As Outlook.Folder
     Dim FoldersArray As Variant
     Dim i As Integer
         
     On Error GoTo GetFolderPath_Error
     If Left(FolderPath, 2) = "\\" Then
         FolderPath = Right(FolderPath, Len(FolderPath) - 2)
     End If
     'Convert folderpath to array
     FoldersArray = Split(FolderPath, "\")
     Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
     If Not oFolder Is Nothing Then
         For i = 1 To UBound(FoldersArray, 1)
             Dim SubFolders As Outlook.Folders
             Set SubFolders = oFolder.Folders
             Set oFolder = SubFolders.Item(FoldersArray(i))
             If oFolder Is Nothing Then
                 Set GetFolderPath = Nothing
             End If
         Next
     End If
     'Return the oFolder
     Set GetFolderPath = oFolder
     Exit Function
         
GetFolderPath_Error:
     Set GetFolderPath = Nothing
     Exit Function
 End Function

Watch Default Contacts Folder Macro

If you mostly save Contacts by clicking on an address in an email message and choosing Save to contacts or drag email to the contacts folder, this macro will watch the default Contacts folder and move any contacts that are saved to the folder.

If you need to save some contacts to the default Contacts folder and some to the iCloud (or another contacts) folder, this macro won't work as it moves all contacts to the iCloud (or another) folder.

Task and Appointment versions of this macro can be found at "Save appointments to a non-default Outlook calendar folder".

Note: it uses the GetFolderPath Function in the macro above.

This macro needs to be in ThisOutlookSession.

Dim WithEvents newContact As Items
  
Private Sub Application_Startup()
   Dim NS As Outlook.NameSpace
   Set NS = Application.GetNamespace("MAPI")
   Set newContact = NS.GetDefaultFolder(olFolderContacts).Items
   Set NS = Nothing
End Sub
  
Private Sub newContact_ItemAdd(ByVal Item As Object)
Set ContactFolder = GetFolderPath("iCloud\Contacts")
Item.Move ContactFolder
End Sub

How to use the macro

First: You will need macro security set to low during testing.

To check your macro security in Outlook 2010 and newer, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, look at Tools, Macro Security.

After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.

Macros that run when Outlook starts or automatically need to be in ThisOutlookSession, all other macros should be put in a module, but most will also work if placed in ThisOutlookSession. (It's generally recommended to keep only the automatic macros in ThisOutlookSession and use modules for all other macros.) The instructions are below.

Now open the VBA Editor by pressing Alt+F11 on your keyboard.

To use the macro code in ThisOutlookSession:

1. Expand Project1 and double click on ThisOutlookSession.
2. Copy then paste the macro into ThisOutlookSession. (Click within the code, Select All using Ctrl+A, Ctrl+C to copy, Ctrl+V to paste.)

To put the macro code in ThisOutlookSession:

1. Expand Project1 and double click on ThisOutlookSession.
2. Copy then paste the macro into ThisOutlookSession. (Click within the code, Select All using Ctrl+A, Ctrl+C to copy, Ctrl+V to paste.)

Application_Startup macros run when Outlook starts. If you are using an Application_Startup macro you can test the macro without restarting Outlook by clicking in the first line of the Application_Startup macro then clicking the Run button on the toolbar or pressing F8.

More information as well as screenshots are at How to use the VBA Editor.