Solved

Macro Question

Posted on 2010-09-03
7
266 Views
Last Modified: 2012-05-10
I would like to change this macro around so that it fits the format of the list already made.

http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_26435925.html#a33564683

 I tried to fit it in but encountered some errors with it. Here it is:

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 & _
                   "Derek Sheahan | Sales Manager TLN Group| tlngroup.com|" & vbCrLf & _
                   "|derek@tlngroup.com | Phone: (1800) 385 8156 | Fax : (1888) 429 7748" & vbCrLf & _
                   "420-2906 West Broadway, Vancouver , BC, V6K 2G8, Canada"
        .Display
    End With

End Sub

I would like to change this to editone and also make one change to it so that it takes the attachments from the current mail selected and adds them to the new mail being created.


Many thanks,

Derek
0
Comment
Question by:TLN_CANADA
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 3
7 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33600054
If I follow then something like this?

Chris
Sub EditOne(mai as variant)
Dim para As Variant
Dim strArray() As String
Dim nuMai 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 numai = Application.CreateItem(olMailItem)
    With numai
    CopyAttachments maiOrig, numai
        .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 & _
                   "Derek Sheahan | Sales Manager TLN Group| tlngroup.com|" & vbCrLf & _
                   "|derek@tlngroup.com | Phone: (1800) 385 8156 | Fax : (1888) 429 7748" & vbCrLf & _
                   "420-2906 West Broadway, Vancouver , BC, V6K 2G8, Canada"
        .Display
    End With

End Sub

Open in new window

0
 

Author Comment

by:TLN_CANADA
ID: 33600131
Thanks Chris,

It is giving an error saying object required and pointing to the line :

 For Each objAtt In objSourceItem.Attachments

of this sub :

Sub CopyAttachments(objSourceItem, objTargetItem)
' See outlookcode.com
Dim FSO As Object
Dim fldTemp As Object
Dim strPath As String
Dim strFile As String
Dim objAtt As Object
Dim fileType As String
 
   Set FSO = CreateObject("Scripting.FileSystemObject")
   Set fldTemp = FSO.GetSpecialFolder(2) 'Temp
   strPath = fldTemp.Path & "\"
   For Each objAtt In objSourceItem.Attachments
      fileType = LCase(Right(objAtt.FileName, Len(objAtt.FileName) - InStrRev(objAtt.FileName, ".")))
        strFile = strPath & objAtt.FileName
        objAtt.SaveAsFile strFile
        objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName
        FSO.DeleteFile strFile
   Next
 
   Set fldTemp = Nothing
   Set FSO = Nothing
End Sub


I think you added this sub also on a previous question?

Thanks,

Derek
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33600210
>>> I think you added this sub also on a previous question?

Indeed we did.

WHat is the object being 'processed'? a mail item an invite or what?

Chris
0
Increase your protection from Zero Day threats!

Running two Antivirus' is never a good idea.
Taking advantage of Multiple Security layers on the other hand can often save your hide.
See which top notch security software brands have been proven to happily coexist together.
Reduce your chances of becoming a statistic.

 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33600225
OOOOOOOOPS!

Too literal a cut and paste.

Chris
Sub EditOne(mai as variant)
Dim para As Variant
Dim strArray() As String
Dim nuMai 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 numai = Application.CreateItem(olMailItem)
    With numai
    CopyAttachments mai, numai
        .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 & _
                   "Derek Sheahan | Sales Manager TLN Group| tlngroup.com|" & vbCrLf & _
                   "|derek@tlngroup.com | Phone: (1800) 385 8156 | Fax : (1888) 429 7748" & vbCrLf & _
                   "420-2906 West Broadway, Vancouver , BC, V6K 2G8, Canada"
        .Display
    End With

End Sub

Open in new window

0
 

Author Comment

by:TLN_CANADA
ID: 33600329
Excellent ! Working now :) One final change to this.

If I could change the subject to the following that would be great :

SUPPLIER NAME - COMPANY NAME - First Unit Confirmation Needed

The lines in the email where I am taking this from are:

> Supplier Order Number: FTN-A135

> Company Name: Test

So the subject would look like: FTN-A135 - Test - First Unit Confirmation Needed

You did something very similar to this on the last macro. I think this is the last thing and then all done. I'll have to ask my boss to add you to the payroll you've helped us out so much!!

Derek
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
ID: 33600398

Sub EditOne(mai as variant)
Dim para As Variant
Dim strArray() As String
Dim nuMai As Object
Dim strSearchFor() As Variant: strSearchFor = Array("> Email:", "> Shipping Company:", "> Tracking Number:", "> Estimated Arrival Date:", "> Contact:", "> Company Name:", "> Supplier Order Number:")
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 numai = Application.CreateItem(olMailItem)
    With numai
    CopyAttachments mai, numai
        .To = strResults(0)
'        .Subject = mai.Subject
        .Subject = strResults(6) & " - " & strResults(5) & " - First Unit Confirmation Needed"
        .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 & _
                   "Derek Sheahan | Sales Manager TLN Group| tlngroup.com|" & vbCrLf & _
                   "|derek@tlngroup.com | Phone: (1800) 385 8156 | Fax : (1888) 429 7748" & vbCrLf & _
                   "420-2906 West Broadway, Vancouver , BC, V6K 2G8, Canada"
        .Display
    End With

End Sub

Open in new window

0
 

Author Closing Comment

by:TLN_CANADA
ID: 33600438
Thank you so much, this is very helpful!
0

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article lists the top 5 free OST to PST Converter Tools. These tools save a lot of time for users when they want to convert OST to PST after their exchange server is no longer available or some other critical issue with exchange server or impor…
When you have clients or friends from around the world, it becomes a challenge to arrange a meeting or effectively manage your time. This is where Outlook's capability to show 2 time zones in one calendar comes in handy.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…

734 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question