Killian,
Thanks!!
I successfully implemented having outlook run the code to open excell, but I can't get it to save the attachments as referenced in the KB.
Below is the code I have in the ThisOutlookSession, I removed the printing part because I do not need that, but I still can't get it to work.
Please Help,
Ross
Dim WithEvents TargetFolderItems As Items
'set the string constant for the path to save attachments
Const FILE_PATH As String = "C:\Documents and Settings\FMi\My Documents\Service Call Logs\FMI Inputs\Extract"
Const TextFilePath As String = "C:\Documents and Settings\FMi\My Documents\Service Call Logs\FMI Inputs\Text Mail\"
Sub Auto(Item As Outlook.MailItem)
Item.SaveAs TextFilePath & Item.Subject & ".txt", olTXT
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Dim fFullPath As String
fFullPath = "C:\Documents and Settings\FMi\My Documents\" & _
"Service Call Logs\FMI Inputs\service call data gathering.xls"
'in the background, create an instance of xl then open the file
Set xlApp = New Excel.Application
Set wb = xlApp.Workbooks.Open(fFullPath)
'the code in the excel file's open event will run
'if not done in the Excel code, you can close
'the workbook and quit Excel here
'tidy up
Set wb = Nothing
Set xlApp = Nothing
End Sub
Private Sub Application_Startup()
'some startup code to set our "event-sensitive" items collection
Dim ns As Outlook.NameSpace
Dim TargetFolder As MAPIFolder
Dim fldr As MAPIFolder, subfldr As MAPIFolder
Set ns = Application.GetNamespace("MAPI")
For Each fldr In ns.Folders
For Each subfldr In fldr.Folders
If subfldr.Name = "Completed Forms" Then
Set TargetFolderItems = subfldr.Items
Exit For
End If
Next
Next
Set ns = Nothing
End Sub
'this is the ItemAdd event code
Sub TargetFolderItems_ItemAdd(ByVal Item As Object)
'when a new item is added to our "watched folder" we can process it
Dim olAtt As Attachment
Dim i As Integer
If Item.Attachments.Count > 0 Then
For i = 1 To Item.Attachments.Count
Set olAtt = Item.Attachments(i)
'save the attachment
olAtt.SaveAsFile FILE_PATH & olAtt.FileName
End If
Set olAtt = Nothing
End Sub
'this is the Application_Quit event code in the ThisOutlookSession module
Private Sub Application_Quit()
Dim ns As Outlook.NameSpace
Set TargetFolderItems = Nothing
Set ns = Nothing
End Sub
Reply With Quote
Originally Posted by rsilberfarb
