macros in microsoft office (outlook)

[Michael_I]

Hello,

I need a macro to scan my inbox (outlook 2000, win xp) and look for any messages with the subject "Test". These e-mails are created by using forms. I need all of the information to be exported to a new excel file in specific columns. For example, the "From:" field should go to cells(1,1) and textbox1 should go to cells(1,2) and the date should go into cells(1,3). After the e-mail is complete it should be deleted, and the macro should scan for any others and offset if it does encounter any.

Does anyone have experience with this?

Thanks,
Mike

[Timbo]

No joy with any previous stuff? http://www.visualbasicforum.com/search.php?searchid=67754
What problems are you getting?

[Michael_I]

Hey,

I have had little help with previous posts, however I am unfamiliar with object variables in Outlook. I am getting an error stating invaild property method or something similar to that. Can you help with the syntax? I have posted the code I am using below. For some reason, I am not able to use the offset function. I think that it has a problem with "ActiveCell".


Sub ExportMessages()
Dim oMailitem As MailItem
Dim oMailItems As Items, i As Long
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
'open excel application
Set xlApp = New Excel.Application
xlApp.Visible = True
'Open excel workbook
Set xlWB = xlApp.Workbooks.Open(FileName:="C:\Documents and Settings\ops\Desktop\Test.xls")
'All messages in current folder
Set oMailItems = Application.ActiveExplorer.CurrentFolder.Items
'Find first Unread message
Set oMailitem = oMailItems.Find("[Subject] = ""Early Out""")
'Loop through all unread messages
Do
If xlWB.ActiveSheet.Cells(1, 1).Value = "" Then
xlWB.ActiveSheet.Cells(1, 1).Value = oMailitem.To
xlWB.ActiveSheet.Cells(1, 2).Value = oMailitem.SentOnBehalfOfName
xlWB.ActiveSheet.Cells(1, 3).Value = oMailitem.SentOn
Else
xlWB.ActiveSheet.Cells(1, 1).Select
xlWB.ActiveSheet.Selection.End(xlDown + 1).Select
xlWB.ActiveSheet.Cells((ActiveCell.Row), 1).Value = oMailitem.To
xlWB.ActiveSheet.Cells((ActiveCell.Row), 2).Value = oMailitem.SentOnBehalfOfName
xlWB.ActiveSheet.Cells((ActiveCell.Row), 3).Value = oMailitem.SentOn
End If
'Find next message
Set oMailitem = oMailItems.FindNext
Loop Until oMailitem Is Nothing

Set oMailitem = Nothing
Set oMailItems = Nothing
'Close workbook
xlWB.Close
'Quit excel
xlApp.Quit
'Clean up memory
Set xlWB = Nothing
Set xlApp = Nothing
End Sub


Thanks,
Mike

[Michael_I]

I have still not solved this problem!!!! I also need information as to the Case Select statement in Outlook. Is it possible to do this, or am I going to have to use If>then statements?

Thanks,
Mike

[JordanChris]

Rather than using:
'All messages in current folder
Set oMailItems = Application.ActiveExplorer.CurrentFolder.Items

I would try using something like:

'All messages in current folder
Set oMailFolder = Application.ActiveExplorer.CurrentFolder
For Each oMailItem in oMailFolder.Items
' In here can test for Subject Contents, e.g.
' If Instr(oMailItem.Subject,"test") > 0 then
MsgBox oMailItem.Subject & " " oMailItem.From
Next

[Michael_I]

I will go ahead and make the change. I am trying to see how this is going to help in the Excel portion of the code though since I can loop through all of the appropriate e-mails it just does not offset when cells(1,1) is greater than empty.

Thanks,
Mike

[Michael_I]

Hey, I have been working on this a little more and I am almost finished. I am having a problem with my messages being read and going to the next. I need the macro to look at the message subject;

If "Early Out" should check to see if Sheets(1).cells(1,1) is empty and paste if it is, if not, loop to the next cell that is empty and paste

If "Long Lunch" should check to see if sheets(2).cells(1,1) is empty and paste if it is, if not, loop to the next cell that is empty and paste

Here is the code that I am using:


Sub ExportMessages()
Dim oMailitem As MailItem
Dim oMailItems As Items
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim intEOrow, intLLrow As Long
'open excel application
Set xlApp = New Excel.Application
xlApp.Visible = True
'Open excel workbook
Set xlWB = xlApp.Workbooks.Open(FileName:="C:\Documents and Settings\ops\Desktop\Test.xls")
'All messages in current folder
Set oMailFolder = Application.ActiveExplorer.CurrentFolder

intEOrow = 1
intLLrow = 1


For Each oMailitem In oMailFolder.Items

Select Case oMailitem.Subject
Case "Early out"

If xlWB.Sheets(1).Cells(intEOrow, 1).Value = "" Then
xlWB.Sheets(1).Cells(intEOrow, 1).Value = oMailitem.To
xlWB.Sheets(1).Cells(intEOrow, 2).Value = oMailitem.SentOnBehalfOfName
xlWB.Sheets(1).Cells(intEOrow, 3).Value = oMailitem.SentOn
Else
intEOrow = intEOrow + 1

End If
Case "Long Lunch"
If xlWB.Sheets(2).Cells(intLLrow, 1).Value = "" Then
xlWB.Sheets(2).Cells(intLLrow, 1).Value = oMailitem.To
xlWB.Sheets(2).Cells(intLLrow, 2).Value = oMailitem.SentOnBehalfOfName
xlWB.Sheets(2).Cells(intLLrow, 3).Value = oMailitem.SentOn
Else
intLLrow = intLLrow + 1

End If
End Select
Next
Set oMailitem = Nothing
Set oMailItems = Nothing
'Close workbook
xlWB.Close
'Quit excel
xlApp.Quit
'Clean up memory
Set xlWB = Nothing
Set xlApp = Nothing
End Sub


Thanks,
Mike

[Michael_I]

I solved the problem with a Do While/Loop.

Thanks,
Mike