Hi Gary,
R u there??
Well, i went through your code & found that you are trying to read
different text files. What if its just a single text file say
TempFile.txt which contains the various MS Outlook email data as shown
in the Template source code as sent earlier?
Also, if there is a way to scan text file for a particular starting
column header in excel say, CSA's Name & then activate the
corresponding excel sheet & dump CSA's Name value under similar Column
Header in excel sheet?
if u have an email address, i can send u a copy of the worksheet which
i am working on.
sending you the source code of the worksheet. Sheet is Named (internal
name shtSetup, caption name Setup)
-------------------------------------------------------------------
Option Explicit
Sub ProcessAll()
Dim rngSubject
Dim retVal
Set rngSubject = shtSetup.Range("A14")
Do While rngSubject.Value <> ""
retVal = ProcessOutlookMessages(Trim(rngSubject.Value), _
Trim(rngSubject.Offset(0, 1).Value),
_
Trim(rngSubject.Offset(0, 2).Value))
If retVal >= 0 Then
rngSubject.Offset(0, 3).Value = rngSubject.Offset(0, 3).Value +
retVal
Else
'negative return value means error
MsgBox "Could not process mails"
Exit Sub
End If
Set rngSubject = rngSubject.Offset(1, 0)
Loop
End Sub
' Extract information from mail items with defined subject and
attachment
Function ProcessOutlookMessages(MailSubject As String, DataSheet As
String, _
ProcessedFolder As String)
Dim olApp As Outlook.Application
Dim fInbox As MAPIFolder
Dim olFolderArchive As Object
Dim olInboxCollection As Object
Dim olInboxItem As Object
Dim TempPath As String
Dim itemCount, i, n, iCount
'temp files saved here
TempPath = ThisWorkbook.Path & "\TempFile.txt"
'If this is the first time calling the sub - get a ref to Outlook
' (must be already running)
If olApp Is Nothing Then
Set olApp = GetOutlook()
End If
'should have it by now....
If olApp Is Nothing Then
ProcessOutlookMessages = -1
Exit Function
End If
'Get the inbox folder
Set fInbox =
olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set olInboxCollection = fInbox.Items
itemCount = olInboxCollection.Count
iCount = 0
For n = itemCount To 1 Step -1
Set olInboxItem = olInboxCollection(n)
'check it's an email and not something else
If TypeName(olInboxItem) = "MailItem" Then
If StrComp(Trim(olInboxItem.Subject), MailSubject) = 0 Then
'Look for archive folder and create if doesn't exist.
Set olFolderArchive = EnsureInboxFolder(fInbox,
ProcessedFolder)
olInboxItem.SaveAs TempPath, olTXT
ProcessFile TempPath, DataSheet
'move the mail to the archive folder
olInboxItem.Move olFolderArchive
iCount = iCount + 1
End If
End If
Next n
ProcessOutlookMessages = iCount
Exit Function
haveError:
If Err <> 0 Then MsgBox "Error:" & vbCrLf & Err.Description
End Function
Sub ProcessFile(TempFilePath As String, WorkSheetName As String)
'#######################
'code goes here to process the temp file and extract the contents. NEED
CODE FOR THIS SUB...
'#######################
End Sub
Function GetOutlook() As Object
Dim olApp As Object
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
MsgBox "Outlook is not running: please open the application first"
End If
Set GetOutlook = olApp
End Function
Function EnsureInboxFolder(oInbox, FolderName) As Object
Dim oFold As Object
'Look for archive folder and create if doesn't exist.
On Error Resume Next 'ignore error
Set oFold = oInbox.Folders(FolderName)
If Err.Number <> 0 Then Err.Clear
If oFold Is Nothing Then
Set oFold = oInbox.Folders.Add(FolderName, olFolderInbox)
End If
Set EnsureInboxFolder = oFold
End Function
Please HELP ASAP!
