Recording data from outlook to an open spreadsheet

[auto_mach]

Hey, all!

I was hoping I could alter my macro to save data to a spreadsheet directly. Below is the macro I have already, where it simply display's a message box with the count. I'd like to save that on a specific cell in a specific sheet that would be open at the time.
This is for a task that has to be ran multiple times a day and the excel workbook will have a different name every time, but the sheet and cell position are always the same.

I've been trying for a while, but I can't get it to run in either Excel or Outlook. This was the original VB script.

Sub WNL()

    Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder
    Dim EmailCount As Integer, CompCount As Integer, totCount As Integer
    Dim strFolder As String
    Dim olMailItem As Outlook.MailItem
    Set objOutlook = CreateObject("Outlook.Application")
    Set objnSpace = objOutlook.GetNamespace("MAPI")


    CompCount = 0
    
        On Error Resume Next
        Set objFolder = Application.GetNamespace("MAPI").Folders("WNL").Folders("Inbox")
        If Err.Number <> 0 Then
        Err.Clear
        MsgBox "No such folder."
        Exit Sub
        End If
    strFolder = objFolder.Parent
    EmailCount = objFolder.Items.Count
    For Each olMailItem In objFolder.Items
        If olMailItem.TaskCompletedDate = "1/1/4501" Then
            GoTo Line1
        Else
            CompCount = CompCount + 1
        End If
Line1:
    Next olMailItem
    
    totCount = (EmailCount - CompCount)
    
    MsgBox "Number of emails in " & strFolder & ": " & totCount, , "email count"
    
    
    Dim dateStr As String
    Dim myItems As Outlook.Items
    Dim dict As Object
    Dim msg As String
    Set dict = CreateObject("Scripting.Dictionary")
    Set myItems = objFolder.Items
    myItems.SetColumns ("ReceivedTime")
    ' Determine date of each message:
    For Each myItem In myItems
        dateStr = GetDate(myItem.ReceivedTime)
        If Not dict.Exists(dateStr) Then
            dict(dateStr) = 0
        End If
        dict(dateStr) = CLng(dict(dateStr)) + 1
    Next myItem


    ' Output counts per day:
    msg = ""
    For Each o In dict.Keys
        msg = msg & o & ": " & dict(o) & " items" & vbCrLf
    Next


    Dim fso As Object
    Dim fo As Object


    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fo = fso.CreateTextFile("Z:\WNL.txt")
    fo.Write msg
    fo.Close


    Set fo = Nothing
    Set fso = Nothing
    Set objFolder = Nothing
    Set objnSpace = Nothing
    Set objOutlook = Nothing
End Sub






Function GetDate(dt As Date) As String
    GetDate = Year(dt) & "-" & Month(dt) & "-" & Day(dt)
End Function

[p45cal]

if running this code from Excel, the line:
Set objFolder = Application.GetNamespace("MAPI").Folders("WNL").Folders("Inbox")
needs to be:
Set objFolder = objOutlook.GetNamespace("MAPI").Folders("WNL").Folders("Inbox")

The code also writes a file (WNL.txt).. you don't need this? Then you can lose a lot of code.

Re: "where it simply display's a message box with the count. I'd like to save that on a specific cell in a specific sheet"
This sheet has a name? If so:
Sheets("YourSheetNameHere").range("E12").value = "Number of emails in " & strFolder & ": " & totCount, , "email count"
or if you don't care about all the text:
Sheets("YourSheetNameHere").range("E12").value = totCount

If the sheet doesn't have a specific name, but is the active sheet at the time then just:
range("E12").value = totCount

The above line to be adjacent to, or to replace, the msgbox line.

[auto_mach]

if running this code from Excel, the line:
Set objFolder = Application.GetNamespace("MAPI").Folders("WNL").Folders("Inbox")
needs to be:
Set objFolder = objOutlook.GetNamespace("MAPI").Folders("WNL").Folders("Inbox")

The code also writes a file (WNL.txt).. you don't need this? Then you can lose a lot of code.

Re: "where it simply display's a message box with the count. I'd like to save that on a specific cell in a specific sheet"
This sheet has a name? If so:
Sheets("YourSheetNameHere").range("E12").value = "Number of emails in " & strFolder & ": " & totCount, , "email count"
or if you don't care about all the text:
Sheets("YourSheetNameHere").range("E12").value = totCount

If the sheet doesn't have a specific name, but is the active sheet at the time then just:
range("E12").value = totCount

The above line to be adjacent to, or to replace, the msgbox line.

I can't believe it was that simple, lol. Guess I still need lots of practice. The only problem was the folder object and now it works perfectly!

As for the last bit where it saves it to a .txt is because I still need to know how many were received on a given day.

But this is awesome! Going to make my day even easier now. Thanks!!