Other Macro Questions

I would like to alter this macro so that it adds the attachments from the current mail to the new email being created and also makes the subject the same subject as the current one.


Finally, in one of the other macros I would like to alter the subject so that it has the subject of the previous email but also adds the word APPROVED to the end of it.

Here is the code line:   oNewEmail.Subject = mai.Subject

Sub Artwork()
Dim para As Variant
Dim strArray() As String
Dim mai As Object
Dim strSearchFor() As Variant: strSearchFor = Array("> Email:", "> Shipping Company:", "> Tracking Number:", "> Estimated Arrival Date:", "> Contact:", "> Company Name:")
Dim strResults() As String
Dim elem As Integer
Const str2 As String = ""
Const str3 As String = ""
Const str4 As String = ""
    
    ReDim strResults(UBound(strSearchFor))
    If TypeName(Application.ActiveWindow) = "Explorer" Then
        Set mai = Application.ActiveExplorer.Selection.Item(1)
    ElseIf TypeName(Application.ActiveWindow) = "Inspector" Then
            Set mai = Application.ActiveInspector.CurrentItem
    Else
        Exit Sub
    End If
    With mai
        strArray = Split(.Body, vbCrLf)
        For Each para In strArray
            If para <> "" Then
                For elem = LBound(strSearchFor) To UBound(strSearchFor)
                    If LCase(Left(para, Len(strSearchFor(elem)))) = LCase(strSearchFor(elem)) Then strResults(elem) = Trim(Split(para, ":")(1))
                Next
            End If
        Next
    End With
    Set mai = Nothing
    If strResults(0) = "" Then Exit Sub
    ' Only proceed if we have an email address!
    Set mai = Application.CreateItem(olMailItem)
    With mai
        .To = strResults(0)
        .Subject = mai.Subject
        .Body = "Dear " & Split(strResults(4) & " ", " ")(0) & vbCrLf & vbCrLf & _
            "Please find attached a photo of the first unit our production has made of your order and kindly confirm it is to your satisfaction before we proceed. If you have any other questions with this order, do not hesitate to ask. " & vbCrLf & vbCrLf & _
            "Best regards," & vbCrLf & _
                   "Derek" & vbCrLf & vbCrLf & _
        .Display
    End With

End Sub

Select allOpen in new window