Save Email into specific folder with file name (X)

[Hudson]

Hi Forum experts,

I have this requirement that is quite simple .. however I have a code already with me . it save email copy into my folder with file name as " date and subject of the email" . to be more dynamic I want small change in the file name to save with " Debit memo number that has come in the email body" .


Below is the email body and I want my email to be save with debit memo number .


AutoZone A/P Adjustment Memo

Merch Payable
123 S. Front Street
Memphis TN, 38108
(901)495-7031 ,OPTION 5 Email - merch.payable@autozone.com


Date DED Date Shipped VIA Memo Number
---- -------- ----------- -----------
10/13/16 06/02/17 JB HUNT TRANSPORT A2734661-001
Authorized By Invoice NO. Purchase Order NO. Warehouse Location
---------------- ----------- ------------------ ------------------
AIU60SA-AIU60SA 3677412 0099300367 ZANESVILLE, OH

Attention: Accounts Receivable Department

Vendor NO. 30125 Vendor name: MELISSA MCINERNEY AR DEPT



A.M. Quantity Invoiced Unit Total
Code Invcd Recvd Description Price Price Price
---- -------- -------- ------------------------- --------- --------- --------
1 1 HS26383PT 110.940 -110.94
1 1 MS97035 16.730 -16.73
1 3 2 MS97185 18.390 -18.39
1 2 VS50034C 4.930 -9.86
1 1 61640 2.670 -2.67
5 FEES -25.00

**** COMMENTS FOLLOW ****



attached is the file with examples for your reference .. kindly help please .

[gmayor]

The following function will get the memo number from the message body, which you can call from your existing macro, PROVIDED THE MESSAGE EXAMPLE IS A TRUE REFLECTION OF THE MESSAGES!
You can test it with the TestMsg macro


Sub TestMsg()
Dim olMsg As MailItem
On Error Resume Next
Set olMsg = ActiveExplorer.Selection.Item(1)
GetMemoNum olMsg
lbl_Exit:
Exit Sub
End Sub

Function GetMemoNum(olItem As MailItem) As String
Dim vText As Variant
Dim sText As String
Dim vItem As Variant
Dim i As Long, j As Long, k As Long

With olItem
sText = .Body
vText = Split(sText, Chr(13))
For i = UBound(vText) To 0 Step -1
If InStr(1, vText(i), "Memo Number") > 0 Then
vItem = Split(vText(i + 2), Chr(32))
k = UBound(vItem)
Do Until Len(vItem(k)) > 0
k = k - 1
Loop
GetMemoNum = vItem(k)
GetMemoNum = Replace(GetMemoNum, "", "")
GetMemoNum = Replace(GetMemoNum, "", "")
Debug.Print GetMemoNum
Exit For
End If
Next i
End With
lbl_Exit:
Exit Function
End Function

[Hudson]

Hi Gmayor, Sorry for the late come back because I have no access towards outlook on weekends . am little confused , because where is the path( all mails go and save) mentioned in the above program , because when I was executing above code nothing happened . or do you want me also include my program too whit above codes ?.

[Hudson]

please find below code for your reference .


Public Sub SaveMessageAsMsg()
Dim oMail As Outlook.MailItem
Dim objItem As Object
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String

enviro = CStr(Environ("USERPROFILE"))
For Each objItem In ActiveExplorer.Selection
If objItem.MessageClass = "IPM.Note" Then
Set oMail = objItem

sName = oMail.Subject
ReplaceCharsForFileName sName, "-"

dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, "-hhnnss", _
vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg"

sPath = enviro & "\Documents\"
Debug.Print sPath & sName
oMail.SaveAs sPath & sName, olMsg

End If
Next

End Sub

Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String _
)
sName = Replace(sName, "'", sChr)
sName = Replace(sName, "*", sChr)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub

[gmayor]

The function I posted reads the piece of data from the message body that you referred to and returns that text as a string which you can use in your code.
You can therefore call that function as required from your code e.g.


sName = GetMemoNum(oMail)

The path and message handling is provided by your code.

[Hudson]

Gmayor, as always you are the best mate.. this is working absolutely working fine..