View Single Post
Old May 6th, 2011, 12:31 PM
tarquinious tarquinious is offline
Experienced Member
First recorded activity by OfficeFrustration: Mar 2011
Posts: 34

Originally Posted by Gregg Medwid View Post
Hi, I am hoping someone can help me with this. I would like to write a macro in Excel that copies the value from a cell, and uses that value to generate a new folder in Outlook Inbox.

Thanks in advance,
Sorry, this has taken me some time as I have not done this before, but I have finally nailed it for you. The trick was that I had to write the macro in Outlook which referred to an Excel spreadsheet.

You will need to add the Macro menu to your menu bar to get into VBA within Outlook. I did this by customising my menu bar and adding Macro.

If you copy and paste the code below into "This Outlook Session" it seems to work. You will see that I have put in variables that you can adjust to read the right columns and rows of data within your spreadsheet.

This macro requires that you have the Excel spreadsheet open to read from as it runs.

Sub ReadExcel()
    Dim ExcelObject As Object
    Dim CellAddress As Variant
    Dim CellRow As Integer
    Dim WorkbookWorksheet As String
    Dim OutlookApp As Outlook.Application
    Dim NewFolder As Outlook.Folder
    Dim OutlookNamespace As Outlook.NameSpace
    Dim OutlookFolder As Outlook.Folder
    ' Set up the spreadsheet you want to read
    On Error Resume Next
    Set ExcelObject = GetObject(, "Excel.Application")
    If Not Err.Number = 0 Then
        MsgBox "You need to have Excel running with the appropriate spreadsheet open first", vbCritical, "Excel Not Running"
    End If
    ' References to Excel Cells and Rows placed here to allow you to modify them easier
    CellRow = 1
    CellAddress = "A" & CellRow
    WorkbookWorksheet = "Sheet1"
    ' Read in the data and create Folder off Inbox for each Excel entry
    Set OutlookApp = Outlook.Application
    Do Until ExcelObject.Range(CellAddress) = ""
        Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
        Set OutlookFolder = OutlookNamespace.GetDefaultFolder(olFolderInbox)
        Set NewFolder = OutlookFolder.Folders.Add(ExcelObject.Range(CellAddress))
        CellRow = CellRow + 1
        CellAddress = "A" & CellRow
End Sub
Any problems, give me a shout.