Extract text in existing message body for use in newmail items

Status
Not open for further replies.
M

mrsadmin

Hi there,

I'm expanding on one of my projects and I'm having issues with 1 section of the code.

Scenario:

Original received mail, I forward as a new obj to my help desk, and the file updates correctly in the helpdesk system.

The problems are this: The mail I'm using has already been forwarded on to me by my distributor (they refuse to send to our support account) and so I lose the very original subject line and the original sender. Luckily the subject line has been saved as part of the text in the email as has the sender. The unlucky part is that it's between "" so my search function has issues.

Please advise.

Existing code:
Code:
Sub Fwdfsp()
   'source:    http://bit.ly/N7ENSk (spiceworks) forward email to helpdesk as new ticket
   'source:    http://bit.ly/1bJRdeQ (microsoft) (on behalf of)
  
 
Dim stsaddress As String 
 
Dim objMail As Outlook.MailItem 
 
Dim strbody As String 
 
Dim oldmsg As String 
 
Dim senderaddress As String 
 
Dim addresstype As Integer 
 
' Set this variable as your helpdesk e-mail address 
 
stsaddress = "my@email" 
 
Set objitem = GetCurrentItem() 
 
Set objMail = objitem.Forward 
 
'Sender email address this is fine for Sup#1, but not for Sup#2
   For Each Recipient In objitem.Recipients
       senderaddress = Recipient.Address 
 
'Get my address for reference in the new email body 
 
myaddress = objitem.CC 
 
'Searches for @ in the email address to determine if it is an exchange user 
 
addresstype = InStr(senderaddress, "@") 
 
' If the address is an Exchange DN use the Senders Name 
 
If addresstype = 0 Then 
 
senderaddress = objitem.Recipients 
 
End If 
 
'adds the senders e-mail address as the created by object for the ticket and appends the message body 
 
strbody = objitem.HTMLBody 
 
objMail.To = stsaddress 
 
objMail.Subject = objitem.Subject 
 
objMail.HTMLBody = strbody & "<br /><br /><font color='#000080' face='Calibri' size='1'>Received by:  " & myaddress & vbNewLine & vbNewLine 
 
objMail.SentOnBehalfOfName = senderaddress 
 
'remove the comment from below to display the message before sending 
 
objMail.Display 
 
'Automatically Send the ticket 
 
'objMail.Send 
 
Next 
 
Set objitem = Nothing 
 
Set objMail = Nothing 
 
End Sub

Sup#1: I actually want objMail.Subject = objitem.Subject to be objMail.Subject = objitem.Body search string "original subject line in body of email"

5DBkPuc.png

Sup#2: I need to get the email address from the text here: Email: address

k7NqYsd.png

I currently have 2 instances of the code, 1 for each of the Distributors as they have different details, as you can see above. The code works well, it's just trying to extract this information.

Thank you :)
 
Thank you, I had a look at that, but I keep running in to the issue that my original Subject is in the email with "original subject" and whenever I use the "" in my queries I keep getting errors.

I also found this a few minutes ago

Code:
Dim start_str As IntegerDim end_str As Integer 
 
Dim mymail As String 
 
start_str = InStr(objitem.Body, " ") + 1 
 
end_str = InStr(objitem.Body, " ") - start_str 
 
newsubj = Mid(objitem.Body, start_str, end_str)

Again it has the issue the my subject is always encased in "" as seen in the image: Sup#1 Attachment 906 above.
 
You could try using chr(34) for the quotes but unless 'original subject' is used throughout the message, i'd look for those works then take the text following it, ending in /n. Even if its used multiple, as long as the one you need is always the first one, it will work.
 
Thanks Admin.

Alas the subject always changes, what we are getting is a copy of the support ticket confirmation that the customer gets from our distributor. So the 'original subject' is always variable, however the " " quote marks are always the same.

Dear Customer,

Our staff has just replied to your ticket "Variable Subject here"
 
Oh. I misunderstood. I thought that was the lead.

Is this always the same: Our staff has just replied to your ticket ?
 
Then you can use it to grab the subject.

regex pattern would be something like

> Pattern = "your ticket\s*(\w*)\s*\n"
 
I feel like i'm the trial & error Queen tonight :) It's taken hours, but I got there in the end. It is not pretty, but I did it.

If you can see a better way then please let me know (I tried Diane's string but it wouldn't move past the ").
.Pattern = "(your ticket (\s*\W*\w*\s*\w*\s*\w*\s*\w*\s*\w*\s*\w*))"

Code:
Sub Fwdfsp()
   'source:    http://bit.ly/N7ENSk (spiceworks) forward email to helpdesk as new ticket
   'source:    http://bit.ly/1bJRdeQ (microsoft) (on behalf of)
   'source:    http://bit.ly/1gfAHAj (techniclee) strip Fwd
   'source:    http://stackoverflow.com/a/20337850/2337102 (find email)
   'source:    http://bit.ly/1cpghpi    (outlook forums setting the regular expression)
   'source:    http://bit.ly/1eQsX56   (slipstick using RegEx)
   'source:    http://bit.ly/1jQrtzY       (regex cheat sheet codes)
   'source:    http://bit.ly/1cZ9AXW   (mrexcel) (remove first character in string)
  
 
Dim stsaddress As String 
 
Dim objMail As Outlook.MailItem 
 
Dim strbody As String 
 
Dim oldmsg As String 
 
Dim senderaddress As String 
 
Dim custmail As String 
 
Dim addresstype As Integer 
 
Dim origsubject As String 
 
Dim newsubject As String 
 
'reg search 
 
Dim Reg1 As RegExp 
 
Dim M1 As MatchCollection 
 
Dim M As Match 
 
Dim strSubject As String 
 
Dim testSubject As String 
 
'gets the original email & creates a new one 
 
Set objitem = GetCurrentItem() 
 
Set objMail = objitem.Forward 
 
'-----     -----     -----     Search & apply from objitem     -----     -----     --- 
'Sender E=mail Address needed for exchange option 
 
For Each Recipient In objitem.Recipients
       custmail = Recipient.Address
       'add  & ";" & strRecip  if more 
 
'Searches for @ in the email address to determine if it is an exchange user 
 
addresstype = InStr(custmail, "@") 
 
'If the address is an Exchange DN use the Senders Name 
 
If addresstype = 0 Then 
 
custmail = objitem.Recipients 
 
End If 
 
'-----     -----     -----     Getting subject from original item using RegEx     -----     -----     --- 
    ' \s* = invisible spaces
   ' \d* = match digits
   ' \w* = match alphanumeric
      
 
Set Reg1 = New RegExp
   With Reg1
         .Pattern = "(your ticket (\s*\W*\w*\s*\w*\s*\w*\s*\w*\s*\w*\s*\w*))"
   '    .Pattern = "your ticket\s*(\w*)\s*"
       .Global = False
   End With
 
   If Reg1.Test(objitem.Body) Then
       Set M1 = Reg1.Execute(objitem.Body)
           For Each M In M1
               'Debug.Print M.SubMatches(1)
               origsubject = M.SubMatches(1)
               'newsubject = M.SubMatches(1)
               'strSubject = Replace(strSubject, Chr(13), "")
               'testSubject = testSubject & "; " & Trim(strSubject)
           'Debug.Print i & origsubject
        Next
   End If 
 
'remove the " at the start of the subject line from origsubject 
 
newsubject = mid(origsubject, 2) 
 
'-----     -----     -----     Setting Variables     -----     -----     --- 
'Set variable email addresses 
 
helpdesk = "support@mail"      'support system 
 
admin = "admin@mail"            'future correspondence 
 
'-----     -----     -----     Getting data from original item     -----     -----     --- 
irisreceived = objitem.CC                                    'address which received original email 
 
distemail = objitem.SenderEmailAddress                 'distributors originating email 
 
custmail = objitem.To                                        'customers address from originating email "to" 
 
'-----     -----     -----     Creating the new email as a modified forward item     -----     -----     --- 
'gets the original body to insert in to the new email 
 
strbody = objitem.HTMLBody 
 
intro = "TaDa" 
 
'setting the email up 
 
objMail.To = helpdesk 
 
objMail.Subject = newsubject 
 
objMail.HTMLBody = intro & strbody 
 
objMail.SentOnBehalfOfName = custmail 
 
' remove the comment from below to display the message before sending 
 
objMail.Display 
 
'Automatically Send the ticket 
 
'objMail.Send 
 
Next 
 
Set objitem = Nothing 
 
Set objMail = Nothing 
 
End Sub
 
Should be able to condense it down to one of these (but i didn't test it)-

> Pattern = "(your ticket\s*([\w-\s]*))\n"

> Pattern = "(your ticket\s*(.*))\s*\n"

The second one covers it if there are non-alphanumeric characters, the \w-\s get alphanumeric and white space.
 
Woot! Got it to work :) Thank you both very much!

From this: "Re Your Product" to: Your Product

I had to remove the " " and then the ' Re ' (the Re caused a whole lot of grief, but I came up with the solution below, from alternative sources).

It's possibly not the neatest code ever written, but so far it does work. :)

Ques:

Your pattern will that work on all email addresses?

It works on a current one: names @domain. tld.country (no spaces) (false @ false. com.au)

Will it work on things like the gmail accepted addresses: name.name+random @gm .com (mrs.admin+outlookforums @gm .com)

or on sub.domains?

From my testing it will do, but I haven't tested all possible combos.

What an awesome little snippet of code! :)

Code:
'source info removed for brevity 
 
Set Reg1 = New RegExp
   With Reg1
         .Pattern = "(your ticket\s*(.*))\s*\n"
         'was:  .Pattern = "(your ticket (\s*\W*\w*\s*\w*\s*\w*\s*\w*\s*\w*\s*\w*))"
       .Global = False
   End With
 
   If Reg1.Test(objitem.Body) Then
       Set M1 = Reg1.Execute(objitem.Body)
           For Each M In M1
               origsubject = M.SubMatches(1)
      Next
   End If
   'origsubject = original found in email
   'basesubject = original less the "" (Quotes)
   'edsub = basesubject, ready to edit in the case of Fwd, Re, etc
   'newsubject = edsub (e) with all the Fwd, Re etc removed as well as any leading remaining whitespaces
   'edsub resulted in the following ' Re Your Product' ( with no ') 
 
basesubject = mid(origsubject, 2, Len(origsubject) - 3) 
 
edsub = basesubject 
 
Dim e As String 
 
e = edsub 
 
e = Replace(e, "RE:", "") 
 
e = Replace(e, "Re", "") 
 
e = Replace(e, "Fw ", "") 
 
e = Replace(e, "Fwd: ", "") 
 
newsubject = LTrim(e) 
 
'-*-*-*-
   'I had tried using another code based on the following however it didn't account for any mid-sentence [I]Fwd/Re[/I] or when ( [I]Fwd: Re:[/I] ) etc:
   'subject has Fwd / Re in it
   'If (Left(objMail.Subject, 4) = "FW: ") Or (Left(objMail.Subject, 4) = "RE:") Then 
 
'        objMail.Subject = mid(objMail.Subject, 5) 
 
'        objMail.Save 
 
'    Else 
 
'        If Left(objMail.Subject, 5) = "Fwd: " Then 
 
'            objMail.Subject = mid(objMail.Subject, 6) 
 
'            objMail.Save 
 
'    Else 
 
'        If Left(objMail.Subject, 3) = "Re " Then 
 
'           objMail.Subject = mid(objMail.Subject, 4) 
 
'           objMail.Save 
 
'        End If 
 
'End If 
 
'End If
 
you mean will this work on email addresses? .Pattern = "(your ticket\s*(.*))\s*\n"

Yes, it will work on anything - the (.*) covered everything between 'your tickets' and a line break.
 
Hi all,

Well, the project is completed, so far :) Since learning about constants I think I want to implement a few in the code. Things like the support email, the distributor email, things like that which won't change.

Here is the "Reply to Distributor (acknowledging I received & forwarded the email)"; "Send to Support System" and "Original from Distributor" emails.

It looks messy, the code doesn't look much better.

I've got 6 versions of the code.

1 Fwd & 1 reply per Distributor account (Only 2 from 4 I deal with)

1 Fwd & 1 reply for customers who email admin instead of Support.

I have kept the versions in 1 module per pair (Fwd & Reply in 1), and I call it through another Macro (very basic "Sub name(), Call name End Sub" (a couple of "IF" statements in there), this way if the distributors ever change the way they send their emails I can just head to that module and fix the 2 that are relevant. I would like to clean it & streamline, but for now this is a huge achievement for me

SO, this is it :) Distributor #2:

IOYPuvD.png


Button:

Code:
Sub stsNew()Dim distemail As String 
 
Set objitem = GetCurrentItem() 
 
distemail = objitem.SenderEmailAddress                 'distributors originating email
     
   If distemail = "info@ wer" Then
      Call stsFSS
   Exit Sub
       Else
     
   If distemail = "sales@ xyz" Then
      Call stsFSP
   Exit Sub
      Else
 
  Call stsISS
         
 
End If 
 
End If 
 
End Sub

The whole code is in part 2 due to character restrictions :)
'source: http://bit.ly/N7ENSk (spiceworks) forward email to helpdesk as new ticket
'source: http://bit.ly/1bJRdeQ (microsoft) (on behalf of)
'source: http://bit.ly/1gfAHAj (techniclee) strip Fwd
'source: http://stackoverflow.com/a/20337850/2337102 (find email)
'source: http://bit.ly/1cpghpi (outlook forums setting the regular expression)
'source: http://bit.ly/1eQsX56 (slipstick using RegEx)
'source: http://bit.ly/1jQrtzY (regex cheat sheet codes)
'source: http://bit.ly/1cZ9AXW (mrexcel) (remove first character in string)
'source: http://bit.ly/1jUx4VO (mrexcel) (remove last character in string)
'source: http://bit.ly/1hdbabz (outlook forums RegEx short .pattern)
'source: http://bit.ly/1jPWSiO (mrexcel) (replace values)

I don't know how to stop having to repeat the "Function GetCurrentItem() As Object", I have to add it in every module, it won't work if I put it in my "FunctCommon" module with the others I use.

Code:
[FONT=Verdana]Function GetCurrentItem() As Object[/FONT] 
 
[FONT=Verdana]Dim objApp As Outlook.Application[/FONT] 
 
[FONT=Verdana]Set objApp = Application[/FONT] 
 
[FONT=Verdana]On Error Resume Next[/FONT] 
 
[FONT=Verdana]Select Case TypeName(objApp.ActiveWindow)[/FONT] 
 
[FONT=Verdana]Case "Explorer"[/FONT] 
 
[FONT=Verdana]Set GetCurrentItem = _[/FONT] 
 
[FONT=Verdana]objApp.ActiveExplorer.Selection.item(1)[/FONT] 
 
[FONT=Verdana]Case "Inspector"[/FONT] 
 
[FONT=Verdana]Set GetCurrentItem = _[/FONT] 
 
[FONT=Verdana]objApp.ActiveInspector.currentItem[/FONT] 
 
[FONT=Verdana]Case Else[/FONT] 
 
[FONT=Verdana]End Select[/FONT] 
 
[FONT=Verdana]End Function[/FONT]
 
And this is the magic (messy, I know):

Part 1/2 (char limit)

Code:
Sub Fwdxyz()
  
 
Dim objMail As Outlook.MailItem 
 
Dim custmail As String 
 
Dim abcsts As String 
 
Dim abcadmin As String 
 
Dim abcreceived As String 
 
Dim distemail As String 
 
Dim strbody As String 
 
Dim addresstype As Integer 
 
'reg search 
 
Dim Reg1 As RegExp 
 
Dim M1 As MatchCollection 
 
Dim M As Match 
 
Dim strSubject As String 
 
Dim testSubject As String 
 
Dim origsubject As String 
 
Dim newsubject As String 
 
'gets the original email & creates a new one 
 
Set objitem = GetCurrentItem() 
 
Set objMail = objitem.Forward 
 
'-----     Search & apply from objitem     --- 
'Sender email Address needed for exchange option 
 
For Each Recipient In objitem.Recipients
       custmail = Recipient.Address
       'add  & ";" & strRecip  if more 
 
'Searches for @ in the email address to determine if it is an exchange user 
 
addresstype = InStr(custmail, "@") 
 
'If the address is an Exchange DN use the Senders Name 
 
If addresstype = 0 Then 
 
custmail = objitem.Recipients 
 
End If 
 
'-----     Getting subject from original item using RegEx     --- 
 Set Reg1 = New RegExp
   With Reg1
         .Pattern = "(your ticket\s*(.*))\s*\n"
       .Global = False
   End With
 
   If Reg1.Test(objitem.Body) Then
       Set M1 = Reg1.Execute(objitem.Body)
           For Each M In M1
                   'Debug.Print M.SubMatches(1)
               origsubject = M.SubMatches(1)
                   'Debug.Print i & origsubject
        Next
   End If 
 
'origsubject = original found in email 
 
'basesubject = original less the "" 
 
'edsub = basesubject, ready to edit in the case of Fwd, Re, etc 
 
'newsubject = edsub (e) with all the Fwd, Re etc removed as well as any leading remaining " " whitespace 
 
basesubject = mid(origsubject, 2, Len(origsubject) - 3) 
 
edsub = basesubject 
 
Dim e As String 
 
e = edsub 
 
e = Replace(e, "RE:", "") 
 
e = Replace(e, "Re", "") 
 
e = Replace(e, "Fw ", "") 
 
e = Replace(e, "Fwd: ", "") 
 
newsubject = LTrim(e) 
 
'-----     Getting customer name from original item using RegEx     --- 
Set Reg1 = New RegExp
   With Reg1
         .Pattern = "(Dear\s*(.*))\s*\n"
       .Global = False
   End With
 
   If Reg1.Test(objitem.Body) Then
       Set M1 = Reg1.Execute(objitem.Body)
           For Each M In M1
                   Debug.Print M.SubMatches(1)
               origname = M.SubMatches(1)
                   'Debug.Print i & origsubject
        Next
   End If 
 
custname = mid(origname, 1, Len(origname) - 2) 
 
'-----     Setting Variables     --- 
'Set variable email addresses 
 
abcsts = "support@ abc"            'support system 
 
abcadmin = "admin@ abc"         'future correspondence 
 
'-----     Getting data from original item     --- 
abcreceived = objitem.CC                 'address which received original email 
 
dist = "xyz"                               'Distributor short code 
 
distemail = objitem.SenderEmailAddress     'distributors originating email 
 
custmail = objitem.To                    'customers address from originating email "to" 
 
origemaildate = objitem.ReceivedTime 
 
'-----     Creating the new email as a modified forward item     --- 
'gets the original body to insert in to the new email 
 
strbody = objitem.HTMLBody 
 
'setting the email up 
 
objMail.To = abcsts 
 
objMail.Subject = newsubject & "  [" & dist & "]" 
 
objMail.HTMLBody = "<font color='#000080' face='Calibri' size='2'>-----     -----<br>" & _
                                           "The below ticket has been received and forwarded on to our Support Ticketing System " & _
                                          "(<a href=''www.abc .com' target='_blank'>sts</a>)." & _
                                          "<br>Sent from:               " & distemail & _
                                          "<br>Customer name:       " & custname & _
                                          "<br>Customer email:       " & custmail & _
                                          "<br>Received by:            " & abcreceived & _
                                          "<br>Forwarded to:      " & abcsts & _
                                          "<br>Forwarded by:            " & abcadmin & _
                                          "<br>Original email date:        " & origemaildate & _
                                          "<br>vvvvvvvv <br>-----     -----<br><br> " & _
                                          "Original message begins:<br>" & _
                                          "-----     -----<br><br> </font>" & strbody 
 
objMail.SentOnBehalfOfName = custmail 
 
objMail.Categories = "CS: D: xyz"
                      
 
objMail.Display                'remove the comment to display message before sending 
 
'objMail.Send                'Automatically Send ticket 
 
Next 
 
Set objitem = Nothing 
 
Set objMail = Nothing 
 
End Sub
 
Cool. Thanks.

GetCurrentItem should error if its in multiple modules - that has always been my experience. It's not labeled private, so it should be seen from any module.

BTW, I'm moving the forum to new software (xenforo, Saturday night if it snows***) and will lift the message size restrictions for all but new members. This forum has just one setting - and yes, i could lift it for all, but I'm too lazy to change the setting. :)

***It's snowed every weekend since Jan 1, so what are the chances? :) If it doesn't snow, we need to visit family out of state.
 
Part 2/2 This is the reply to the distributor.

I had tried to reduce the Regex down to the CASE example as per Diane's REGEX page (here), however I couldn't figure out how to set the 2 different pieces of detail (subject & name), it would just revert to the Subject.

Code:
Sub Replytoxyz() 
 
Dim objMail As Outlook.MailItem 
 
Dim custmail As String 
 
Dim abcsts As String 
 
Dim abcadmin As String 
 
Dim abcreceived As String 
 
Dim distemail As String 
 
Dim strbody As String 
 
Dim addresstype As Integer 
 
'Set objitem = GetCurrentItem() 
 
Set objitem = ActiveExplorer.Selection.item(1) 
 
If TypeName(ActiveExplorer.Selection.item(1)) = "MailItem" Then
Set oMail = ActiveExplorer.Selection.item(1)
End If 
 
' For a reply or reply all, replace forward  with Reply or ReplyAll 
 
Set objMail = objitem.Forward
On Error Resume Next 
 
'Sender email Address needed for exchange option 
 
For Each Recipient In objitem.Recipients
    senderaddress = Recipient.Address
    'add  & ";" & strRecip  if more 
 
Next Recipient 
 
'-----     Getting subject from original item using RegEx     --- 
Set Reg1 = New RegExp
   With Reg1
         .Pattern = "(your ticket\s*(.*))\s*\n"
       .Global = False
   End With
 
   If Reg1.Test(objitem.Body) Then
       Set M1 = Reg1.Execute(objitem.Body)
           For Each M In M1
                   'Debug.Print M.SubMatches(1)
               origsubject = M.SubMatches(1)
                   'Debug.Print i & origsubject
        Next
   End If 
 
'origsubject = original found in email 
 
'basesubject = original less the "" 
 
basesubject = mid(origsubject, 2, Len(origsubject) - 3) 
 
newsubject = basesubject 
 
'-----     Getting customer name from original item using RegEx     --- 
Set Reg1 = New RegExp
   With Reg1
         .Pattern = "(Dear\s*(.*))\s*\n"
       .Global = False
   End With
 
   If Reg1.Test(objitem.Body) Then
       Set M1 = Reg1.Execute(objitem.Body)
           For Each M In M1
                   Debug.Print M.SubMatches(1)
               origname = M.SubMatches(1)
                   'Debug.Print i & origsubject
        Next
   End If 
 
custname = mid(origname, 1, Len(origname) - 2)
   
 
'-----     Setting Variables     --- 
'Set variable email addresses 
 
abcsts = "support@ abc"        'support system 
 
abcadmin = "admin@ abc"     'future correspondence 
 
'-----     Getting data from original item     --- 
abcreceived = objitem.CC                'address which received original email 
 
dist = "xyz"                                         'Distributor short code 
 
distemail = objitem.SenderEmailAddress  'distributors originating email 
 
custmail = objitem.To                           'customers address from originating email "to" 
 
origemaildate = objitem.ReceivedTime 
 
foremaildate = Format(Now) 
 
'set other items 
 
strbody = objitem.HTMLBody 
 
sig = ReadSignature("abc - all.htm") 
 
objMail.To = distemail 
 
objMail.Subject = "Re: " & objitem.Subject & "  (" & newsubject & ")" & "  [" & dist & "]" 
 
objMail.HTMLBody = "<font color='#000080' face='Calibri' size='2'>-----     -----<br>" & _
                                           "Hi Team, <br><br>" & _
                                           "The below ticket has been received and forwarded on to our Support Ticketing System " & _
                                           "(<a href='www.abc .com' target='_blank'>sts</a>).<br>" & _
                                           "The customer should expect contact within the next 48-72 hours, longer if sent over a weekend or public holiday.<br>" & _
                                           "If you would like the reference number for their support ticket for your records please let me know.<br><br>" & _
                                           "<br>Sent from:     " & distemail & _
                                           "<br>Customer name:       " & custname & _
                                           "<br>For Customer:      " & custmail & _
                                           "<br>Received by:        " & abcreceived & _
                                           "<br>Forwarded to:     " & abcsts & _
                                           "<br>Forwarded by:      " & abcadmin & _
                                           "<br>Original email date:        " & origemaildate & _
                                           "<br>Forward email date:       " & foremaildate & _
                                           "<br><br>Please do not hesitate to contact us if you have further questions.<br><br>Thank you<br><br>" & _
                                           sig & "-----     -----<br></font>" & strbody 
 
objMail.SentOnBehalfOfName = abcadmin 
 
objMail.Categories = "CS: D: xyz" 
 
objMail.Display                'remove the comment to display message before sending 
 
'objMail.Send                'Automatically Send ticket 
 
Set objitem = Nothing 
 
Set objMail = Nothing 
 
End Sub

And I'm done ... sorry for the 3 posts but the code is huge and had to be split up :)

I really should learn more so I can reduce it more ;D
 
Cool. Thanks.

GetCurrentItem should error if its in multiple modules - that has always been my experience. It's not labeled private, so it should be seen from any module.

BTW, I'm moving the forum to new software (xenforo, Saturday night if it snows***) and will lift the message size restrictions for all but new members.

***It's snowed every weekend since Jan 1, so what are the chances? :) If it doesn't snow, we need to visit family out of state.

We've had huge extremes here, up to 42oC days, as low as 13oC. Completely weird weather, and hubby's family are being flooded in the UK. Mother Nature has gone mad this year.

Considering the amount of duplicate code I have, what's another "Function", I found it odd it wouldn't pick up from my central function module, but, I don't know any better :)

I have 1 in there that is used for the Categories code that I use, and even though they are identical in code, when I delete the "CurrentItem" in my personal module I get the "Ambiguous Name" error. If I leave them both in, (common & personal) there aren't any errors.

I didn't see your reply before I posted Part 2 of the code.

I'm just thrilled that this project has worked, and it was from the help here that made it happen. I'm such a n00b :) hehe.
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
S Unable to extract text from an Outlook email message Using Outlook 2
K extract certain text from an Outlook Email Message Outlook VBA and Custom Forms 2
D VBA Script to extract text matching specific criteria Outlook VBA and Custom Forms 1
R Saving Outlook Email As Text File Extract Outlook VBA and Custom Forms 2
C Wishlist Extract or scan new email addresses from out of office replies. Leads from OOO replies Using Outlook 1
D ISOmacro to extract active mail senders name and email, CC, Subject line, and filename of attachments and import them into premade excel spread sheet Outlook VBA and Custom Forms 2
M Extract "Date sent" from emails (saved to folder using drag and drop) Outlook VBA and Custom Forms 1
T vba extract data from msg file as attachment file of mail message Outlook VBA and Custom Forms 1
S Macro to extract and modify links from emails Outlook VBA and Custom Forms 3
S Macro to extract email addresses of recipients in current drafted email and put into clipboard Outlook VBA and Custom Forms 2
C Macro to extract sender name & subject line of incoming emails to single txt file Outlook VBA and Custom Forms 3
N Extract Outlook emails to excel Outlook VBA and Custom Forms 2
M Extract all links from Outlook email, send to Excel Using Outlook 2
T Extract Data From Outlook Tasks Using Outlook 0
T Extract Data From Outlook Tasks Using Outlook 0
V extract users of a particular department Outlook VBA and Custom Forms 1
J Outlook 2013 Extract Flag Completed dates to Excel Macro Outlook VBA and Custom Forms 16
S How to extract mail items from multiple folders and shared mailboxes? Outlook VBA and Custom Forms 0
K Extract email address from body and auto-reply outlook Using Outlook 1
R Trying to extract information between two symbols from outlook subject Using Outlook 2
K Extract email to excel from a specific sender Outlook VBA and Custom Forms 3
O VBA to extract email (fields and body) to Excel Outlook VBA and Custom Forms 14
P Recover / Extract Rules from standalone PST file creating RWZ file Using Outlook 2
B Extract Dates for Appointment Item in Body of email Outlook VBA and Custom Forms 10
D Need to extract a line from a word attachment, and add it to the subject line Outlook VBA and Custom Forms 3
E Extract excel files from outlook Outlook VBA and Custom Forms 2
M HELP--Extract Data from 2003 outlook transfer to excel spreadsheet Using Outlook 1
M VBA Code to extract data from an Outlook Form Using Outlook 0
M Extract attachments with a script Using Outlook 0
M HELP - Can't open outlook... How can I extract my Emails that I had in folders Using Outlook 3
H Extract emails from Outlokk 2007 email body Using Outlook 0
K Extract Global Address List Using Outlook 1
N Programming to extract automatically extract attachments Outlook VBA and Custom Forms 3
S How to extract outlook calendar data. Outlook VBA and Custom Forms 3
? outlook attachment Extract File ??? Outlook VBA and Custom Forms 1
N How to extract date and time stamp from messsages Outlook VBA and Custom Forms 6
V Extract Subject,Sent From, Message from mailbox to Excel Outlook VBA and Custom Forms 5
S Automatically extract attachments? Outlook VBA and Custom Forms 1
I How to extract email addresses from TO or CC line of a particular email Outlook VBA and Custom Forms 2
AndyZ Contact Custom Form Tiny Text Outlook VBA and Custom Forms 3
D Delete selected text in outgoing email body Outlook VBA and Custom Forms 0
kburrows Outlook Email Body Text Disappears/Overlaps, Folders Switch Around when You Hover, Excel Opens Randomly and Runs in the Background - Profile Corrupt? Using Outlook 0
J PSA: How to create custom keyboard shortcut for "Paste Unformatted Text" in Outlook on Windows Outlook VBA and Custom Forms 1
Witzker Add a text line at the end of the note field in all selected Contacts Outlook VBA and Custom Forms 7
O Replace hard returns with soft returns on selected text and button to QAT Using Outlook 5
J Outlook 365 Emails showing as links and text only Using Outlook 4
R How to force Outlook to use plain text in notes for Contacts? Using Outlook 1
J Text icon in Quick Access toolbar ? Using Outlook 2
S New Outlook Appointment - Select All Body Text and Change Font and Size Outlook VBA and Custom Forms 1
Z Copy specific email body text Outlook VBA and Custom Forms 0

Similar threads

Back
Top