Skip to content

Instantly share code, notes, and snippets.

@discarn8

discarn8/Extract_data_from_emails_write_to_text_file.vba

Created May 16, 2018 22:28
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save discarn8/e229495f4eaa7a1a58a2501e2ef48629 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save discarn8/e229495f4eaa7a1a58a2501e2ef48629 to your computer and use it in GitHub Desktop.
Download ZIP
OUTLOOK - Extract_data_from_emails_write_to_text_file.vba
Raw
Extract_data_from_emails_write_to_text_file.vba
Public Sub EXTRACT_INFORMATION()
Dim var1, var2, var3, var4, WL, em, WLC, oFSO, oFS, fso, bstring, When, var5 As String
Dim MsgCount, var6, var7, var8, var9, ErrCheck, var10 As Integer
Dim rrVar, lrVar, rdVar, ldVar, lsVar, rsVar, lc, Target
Dim oMailS As Outlook.MailItem
' --------------------------------------------------------------------
Set objOutlook = CreateObject("Outlook.Application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objFolder = Application.ActiveExplorer.CurrentFolder.Items
Set colItems = objFolder
Set fso = CreateObject("Scripting.FileSystemObject")
' Set oMailS = Application.ActiveExplorer.Selection(1)
'Set objFolder = objNameSpace.GetDefaultFolder(olFolderInbox)
' --------------------------------------------------------------------
em = ""
MsgCount = 0
var6 = 0
var7 = 0
var8 = 0
var9 = 0
ErrCheck = 0
var11 = ""
var21 = ""
var4 = ""
var24 = ""
AName = ""
ZName = ""
var22 = ""
var23 = ""
' --------------------------------------------------------------------
On Error GoTo errorHandler 'If there are any errors - SQUAWK!
' --------------------------------------------------------------------
' ----------------------------------------------------------------------------------
' Begin scrolling through the e-mails one at a time in the current folder
' ----------------------------------------------------------------------------------
For Each objMessage In colItems
When = objMessage.CreationTime
MsgCount = MsgCount + 1
' ----------------------------------------------------------------------------------
' Start processing and check to see if the email is from NetMon.com
' ----------------------------------------------------------------------------------
If InStr(LCase(objMessage.SenderEmailAddress), "NetMon.com") Then 'IF1 NetMon?
' ----------------------------------------------------------------------------------
' If the email is from NetMon.com - continue
' ----------------------------------------------------------------------------------
var7 = var7 + 1
If InStr(UCase(objMessage.Body), "PLEASE CHECK") Then 'IF2 Please Check1?
var8 = var8 + 1
If InStr(UCase(objMessage.Body), "SYSTEM var2:") Then 'IF3 System var2?
var9 = var9 + 1
bstring = objMessage.Body
msgLines = Split(bstring, vbCrLf)
For Each msgLine In msgLines
If InStr(LCase(msgLine), "var1") Then
msgLine = Split(msgLine, ": ")(1) ' If found, split the line
'msgLine = Replace(msgLine, "var1", "") ' If found, replace it
var1 = msgLine
End If
If InStr(LCase(msgLine), "var2:") Then
msgLine = Replace((Split(msgLine, ":")(1)), " ", "") ' If found, split the line
'msgLine = Replace(msgLine, "var2", "") ' If found, replace it
var2 = msgLine
End If
If InStr(LCase(msgLine), "var3") Then
msgLine = Replace(msgLine, "var3: ", "") ' If found, replace it
var3 = msgLine
End If
If InStr(LCase(msgLine), "var4:") Then
msgLine = Split(msgLine, "var4: ")(1) ' If found, replace it
var4 = msgLine
End If
If InStr(LCase(msgLine), "var12:") Then
msgLine = Replace(msgLine, "var12: ", "") ' If found, replace it
var12 = msgLine
End If
If InStr(LCase(msgLine), "var5") Then
msgLine = Split(msgLine, "> ")(1) ' If found, replace it
var5 = msgLine
End If
Next
' ----------------------------------------------------------------------------------
' Write the email info to a text file
' ----------------------------------------------------------------------------------
If Len(var1) > 1 Then
If Len(var2) > 1 Then
WL = "|" & var1 & "|" & var2 & "|" & var5 & "|" & var3 & "|" & var4 & "|" & var12 & "|" ' & vbNewLine
WL = Replace(WL, ",|", "|")
WL = Replace(WL, "|,", "|")
WL = Replace(WL, ",,||", "||")
Open "\\fs5\it\Telephony\User_Folders\Combs\Extract\var1s.txt" For Append As 1
Print #1, WL
Close #1
End If
End If
' ----------------------------------------------------------------------------------
' ------- Clear all message variables ------
' ----------------------------------------------------------------------------------
dResult = ""
Set rResult = Nothing
bstring = ""
Set rrVar = Nothing
Set lrVar = Nothing
var2 = ""
WL = ""
var1 = ""
var4 = ""
var12 = ""
Set lc = Nothing
When = ""
' ----------------------------------------------------------------------------------
' End the "var2" email If-then check
' ----------------------------------------------------------------------------------
End If
var6 = var6 + 1 ' Increment our counter by 1
' ----------------------------------------------------------------------------------
' End the "var3" email If-then check
' ----------------------------------------------------------------------------------
End If
' ----------------------------------------------------------------------------------
' ------------ If not from netmon then check to see if it's from emailhost instead
' ----------------------------------------------------------------------------------
ElseIf InStr(LCase(objMessage.SenderEmailAddress), "[email protected]") Or _
InStr(LCase(objMessage.SenderEmailAddress), "[email protected]") Then
var10 = var10 + 1
bstring = objMessage.Body
msgLines = Split(bstring, vbCrLf)
i = 0
For Each msgLine In msgLines
If InStr(msgLine, "CORP NAME") Then
var20 = Split(msgLine, vbTab)
var21 = var20(0)
var24 = var20(1)
AName = var20(2)
ZName = var20(3)
var22 = var20(4)
var23 = var20(5)
End If 'IF var11s
If InStr(LCase(msgLine), "var4") Then
j = i + 2
msgLine = msgLines(j) ' If found, replace it
var4 = msgLine
j = 0
End If
If InStr(UCase(msgLine), "var11") Then
msgLine = Replace(msgLine, ": ", "")
msgLine = Replace(msgLine, "var11", "")
var20 = msgLine
End If
If var21 = "" Then
Else
var11 = "|" & var24 & "|" & AName & "|" & ZName & "|" & var22 & "|" & var4 & "|" & var23 & "|"
Open "\\network_share\Folders\storage_file.txt" For Append As 1
Print #1, var11
Close #1
var24 = ""
AName = ""
ZName = ""
var22 = ""
var23 = ""
var11 = ""
var21 = ""
End If
i = i + 1
Next
Else
dResult = ""
Set rResult = Nothing
bstring = ""
Set rrVar = Nothing
Set lrVar = Nothing
var2 = ""
WL = ""
var1 = ""
var4 = ""
var12 = ""
Set lc = Nothing
Target = ""
var20 = ""
var5 = ""
' ----------------------------------------------------------------------------------
' End of NetMon and emailhost Check
' ----------------------------------------------------------------------------------
End If 'IF1
' ----------------------------------------------------------------------------------
' Proceed to the next e-mail
' ----------------------------------------------------------------------------------
Next 'For Each objMessage In colItems
' ----------------------------------------------------------------------------------
' ------- When all of the emails have been processed ------
' ------- Clear all script variables ------
' ----------------------------------------------------------------------------------
Set objOutlook = Nothing 'Clean things up
Set objNameSpace = Nothing 'Clean things up
Set objFolder = Nothing 'Clean things up
Set colItems = Nothing 'Clean things up
Set fso = Nothing 'Clean things up
' ----------------------------------------------------------------------------------
' ------------ Provide a line-by-line summary when extraction is complete
' ----------------------------------------------------------------------------------
MsgBox (vbNewLine & _
"Extraction complete. " & vbNewLine & _
MsgCount & " emails processed." & vbNewLine & _
var6 & " emails saved." & vbNewLine & _
"var7 Emails: " & var7 & vbNewLine & _
"Var8 Emails: " & var8 & vbNewLine & _
"var10 Emails: " & var10 & vbNewLine & _
"var9 Emails: " & var9 & vbNewLine & _
"Error Count = " & ErrCheck & vbNewLine)
' ----------------------------------------------------------------------------------
' ------------ Dump that puppy to a file
' ----------------------------------------------------------------------------------
Open "\\network_share\Folders\errorlog.txt" For Append As 1
Print #1, em
Close #1
em = "" ' ----CLEAR the Error Message log
' ----------------------------------------------------------------------------------
' ----- We are done here - go home
' ----------------------------------------------------------------------------------
Exit Sub 'Dishes are DONE MAN!
' ----------------------------------------------------------------------------------
' ------------ Error-handling routine.
' ----------------------------------------------------------------------------------
errorHandler:
' ------------ Add current error to our error log string
em = em & Date & " - Error: " & Error(Err) & " for message: " & objMessage.Subject & vbNewLine
' ------------ increment our error count
ErrCheck = ErrCheck + 1
Resume Next 'Go back to after where the error occurred
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment