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          [B]A2734661-001[/B] 
  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..