PDA

View Full Version : [SOLVED] Recording data from outlook to an open spreadsheet



auto_mach
07-16-2015, 11:27 AM
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




:thumb

p45cal
07-16-2015, 12:14 PM
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
07-16-2015, 12:26 PM
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!!