P
Patrick Stafford
I am working on a macro to search for email messages that contain "VZ-East"
in the subject and then importing the message into an excel document. I have
the following code, but cannot get it to work or no what else to do. Any
help will be greatly appreciated. Thanks!
Sub import()
Dim olApp As Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim myFol As Outlook.MAPIFolder, myAtt As Attachment
Dim objReg As Outlook.MAPIFolder
Dim objPF As Outlook.MAPIFolder
Dim objItem As MailItem
Set olApp = CreateObject("Outlook.Application")
Set objNameSpace = olApp.GetNamespace("MAPI")
Set myFol = objNameSpace.GetDefaultFolder(olFolderInbox)
Set objPF = objNameSpace.Folders("Local Mailbox")
Set objReg = objPF.Folders("Reg_file")
' Open Excel file first
Dim xlApp As Object
Set xlApp = CreateObject("excel.application")
With xlApp
.ScreenUpdating = False
.Visible = False
.workbooks.Open ("C:\PON Email\master.xls")
.DisplayAlerts = False
End With
' For each message, check for subject containing VZ-East
For Each Item In myFol.Items
If InStr(Item.Subject, "VZ-East") > 0 Then
Set objItem = olApp.ActiveInspector.CurrentItem
objItem.SaveAs "C:\Windows\Temp\Postdata.att", olTXT
xlApp.Run "master.xls!DoTheImport"
xlApp.Save
Kill "C:\Windows\Temp\Postdata.att"
' Move msg to [Personal Folders/Reg_file]
Item.Move objReg
End If
Next Item
' Quit excel
xlApp.Quit
End Sub
in the subject and then importing the message into an excel document. I have
the following code, but cannot get it to work or no what else to do. Any
help will be greatly appreciated. Thanks!
Sub import()
Dim olApp As Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim myFol As Outlook.MAPIFolder, myAtt As Attachment
Dim objReg As Outlook.MAPIFolder
Dim objPF As Outlook.MAPIFolder
Dim objItem As MailItem
Set olApp = CreateObject("Outlook.Application")
Set objNameSpace = olApp.GetNamespace("MAPI")
Set myFol = objNameSpace.GetDefaultFolder(olFolderInbox)
Set objPF = objNameSpace.Folders("Local Mailbox")
Set objReg = objPF.Folders("Reg_file")
' Open Excel file first
Dim xlApp As Object
Set xlApp = CreateObject("excel.application")
With xlApp
.ScreenUpdating = False
.Visible = False
.workbooks.Open ("C:\PON Email\master.xls")
.DisplayAlerts = False
End With
' For each message, check for subject containing VZ-East
For Each Item In myFol.Items
If InStr(Item.Subject, "VZ-East") > 0 Then
Set objItem = olApp.ActiveInspector.CurrentItem
objItem.SaveAs "C:\Windows\Temp\Postdata.att", olTXT
xlApp.Run "master.xls!DoTheImport"
xlApp.Save
Kill "C:\Windows\Temp\Postdata.att"
' Move msg to [Personal Folders/Reg_file]
Item.Move objReg
End If
Next Item
' Quit excel
xlApp.Quit
End Sub