Const LineFeed As String = "&&&"
Sub GetInbox()
Dim olApp, olNamespace, olInbox, olItem
Dim regex, REGM
Dim tmpStr As String, myVar As String
strFileName = "c:\test.csv"
Set objFS = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set objTS = objFS.getfile(strFileName)
If Err.Number <> 0 Then objFS.CreateTextFile strFileName
On Error GoTo 0
Set objTS = objFS.OpenTextFile(strFileName, 8)
Set regex = CreateObject("vbscript.regexp")
Set olApp = CreateObject("Outlook.Application")
Set olNamespace = olApp.GetNamespace("MAPI")
Set olInbox = olNamespace.GetDefaultFolder(6).Folders("temp")
strFileName = "c:\test.csv"
Set objFS = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set objTS = objFS.getfile(strFileName)
If Err.Number <> 0 Then objFS.CreateTextFile strFileName
On Error GoTo 0
Set objTS = objFS.OpenTextFile(strFileName, 8)
With regex
.Pattern = "[\f\r\n\t]{1}"
.Global = True
.MultiLine = True
.IGNORECASE = True
For Each olItem In olInbox.items
tmpStr = .Replace(olItem.body, LineFeed)
.Pattern = "Core Data\s{1,}" & LineFeed & "{1,}(.+?)" & LineFeed & "{1,}(.+?)" & LineFeed
myVar = vbNullString
If .test(tmpStr) Then
Set REGM = .Execute(tmpStr)
myVar = Replace(Replace(REGM(0).submatches(1), LineFeed, vbNullString), ",", ":")
End If
objTS.Write olItem.SenderName & ", " & olItem.Subject & ", " & olItem.ReceivedTime & ", " & myVar
objTS.writeline
Next
End With
objTS.Close
Set olApp = Nothing
End Sub
|