• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 479
  • Last Modified:

Outlook 2003 Ebay reminder?

Ebay used to have a slick little "add to calendar" button that created an outlook appointment for the ending auction, but its no longer there (no longer supported according to them).  So I was wondering if anyone had any ideas how to do something similar.  I was thinking of somehow screwing with the 'email to friend" function so that if you email the listing to yourself it would somehow, by running a macro, add the item to your appointment list.  

Any thoughts?  Maybe there's a better way?
0
jglazer63
Asked:
jglazer63
  • 7
  • 6
1 Solution
 
David LeeCommented:
Hi, jglazer63.

Where do you want to do this from, eBay's site?
0
 
jglazer63Author Commented:
I actually wrote a VB macro in outlook that if you use the 'email to friend' feature of ebay's items it pulls the information from there and creates an appointment (in your time zone no less!) for when the item expires.  Pretty slick if I do say so myself. So now I just 'email a friend' to myself and boom, appointment made hehe.

Thanks for the reply though!
0
 
DonPhillipeCommented:
Can you tell us how to do this?  Thanks!
0
Easily manage email signatures in Office 365

Managing email signatures in Office 365 can be a challenging task if you don't have the right tool. CodeTwo Email Signatures for Office 365 will help you implement a unified email signature look, no matter what email client is used by users. Test it for free!

 
jglazer63Author Commented:
Here is the readme file and the .BAS script to do this.
-----------------------readme.txt----------------
Installation:

1. Download and install the Outlook redemption package at
      http://www.dimastr.com/redemption/
   The free developer version will work fine since this is not commercial software.    
     

1. Open up Tools > Macro > Visual Basic Editor.  Paste in ebayreminder.bas as a NEW MODULE in a project (either a new one or the existing default one).

2. Go to the Start menu, and then Microsoft Office > Microsoft Office Tools > Digital Certificate for VBA Projects.  Run it and create a digital certificate for your local machine.  I usually give my name.

3. Go back to the macro editor and select Tools > Digital Signature and Choose your newly minted signature.

4. Got to Tools > Macros.  A security warning should come up asking about macros made by your certificate name.  Select "Always trust macros from this publisher" and Enable macros

5. Setup a rule that runs:
  When there are specific words in the subject: "thought you might like this item on eBay"
  It will RUN A SCRIPT: "Project1.eBayReminder"
 
Use:

Simply go to the ebay item your interested in and EMAIL A FRIEND with your own email address.  Thats it.  



--------------ebayreminder.bas---------------
Option Explicit
'Version 1.2
'Copyright Jon Glazer
'***********************************************************************
'This program is provided free for non-commercial use.  No warantee
'explicit or otherwise is provided.
'***********************************************************************
 
Function GetUTC() As String
  Dim oShell As Object
  Dim OffSetMin
  Set oShell = CreateObject("WScript.Shell")
  OffSetMin = oShell.RegRead("HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")
  Set oShell = Nothing
  GetUTC = OffSetMin / 60
End Function
Private Sub SplitURL(Link As String, ItemNum As String, ItemName As String)
  MsgBox (Link)
  Exit Sub
  Dim TempA
  Dim X As Integer
  Link = Mid(Link, InStr(Link, """") + 1)
  ItemName = Mid(Link, InStr(Link, """") + 1)
  Link = Mid(Link, 1, InStr(Link, """") - 1)
  Link = Mid(Link, InStr(Link, "?") + 1)
  TempA = Split(Link, "&")
  For X = 0 To UBound(TempA)
    If InStr(LCase(TempA(X)), "item=") = 1 Then ItemNum = Mid(TempA(X), 6)
  Next
End Sub
Sub WriteToFile(Data As String)
  Dim objFS As Object
  Dim oFile As Object
  Set objFS = CreateObject("scripting.filesystemobject")
  Set oFile = objFS.CreateTextFile("d:\dl\test.txt")
  oFile.Write (Data)
  oFile.Close
End Sub
Sub eBayReminder(MyMail As MailItem)
  Const TZDiff = 3
  Dim sItem As Object
  Dim objAppItem As Outlook.AppointmentItem
  Dim objApp As Outlook.Application
  Dim BodyLines
  Dim X, Y As Integer
  Dim Line As String
  Dim ItemNumber As String
  Dim ItemName As String
  Dim EndTime As String
  Dim Body As String
  Dim TempA
  Set objApp = Outlook.Application
  Set sItem = CreateObject("Redemption.SafeMailItem")
  sItem.Item = MyMail
  ItemNumber = ""
  ItemName = ""
  EndTime = ""
  If InStr(MyMail.Subject, "thought you might like this item on eBay") <= 0 Then Exit Sub
  Body = sItem.Body
'  WriteToFile (Body)
  BodyLines = Split(Body, vbCrLf)
  Set sItem = Nothing
  For X = 0 To UBound(BodyLines)
      Line = BodyLines(X)
      If ItemNumber = "" And InStr(Line, "ViewItem") > 0 Then
        TempA = Split(Mid(Line, InStr(Line, "?") + 1), "&")
        For Y = 0 To UBound(TempA)
          If InStr(LCase(TempA(Y)), "item=") = 1 Then ItemNumber = Mid(TempA(Y), 6)
        Next
      End If
      If InStr(Line, "ViewItem") > 0 And ItemName = "" Then
        Y = InStr(Line, "<http:")
        If Y > 0 Then
          ItemName = Trim(Mid(Line, 1, Y - 1))
        End If
      End If
'      If ItemName = "" And InStr(Line, "Item name:") > 0 Then
'        ItemName = Trim(Mid(Line, InStr(Line, ":") + 1))
'      End If
      If EndTime = "" And InStr(Line, "End time:") > 0 Then
        EndTime = Trim(Mid(Line, InStr(Line, ":") + 1))
        EndTime = Mid(EndTime, 1, Len(EndTime) - 4)
        EndTime = DateAdd("h", TZDiff, EndTime)
      End If
'    Next
  Next
  If ItemNumber = "" Then MsgBox ("Could not create eBay appt.  Could not figure out Item Number")
  If ItemName = "" Then MsgBox ("Could not create eBay appt.  Could not figure out Item Name")
  If EndTime = "" Then MsgBox ("Could not create eBay appt.  Could not figure out End Time")
  If ItemNumber = "" Or ItemName = "" Or EndTime = "" Then Exit Sub
               
  MsgBox ("Create Appointment:" & vbCrLf & "Ebay: " & ItemName & vbCrLf & "Ending: " & EndTime)
  Set objAppItem = objApp.CreateItem(olAppointmentItem)
  objAppItem.Subject = "Ebay: " & ItemName
  objAppItem.Start = EndTime
  objAppItem.Body = "http://cgi.ebay.com/ws/eBayISAPI.dll?viewitem&item=" & ItemNumber
  objAppItem.Close olSave
  Set objApp = Nothing
  MyMail.Delete
End Sub
 
Sub TestIt()
    Dim objApp As Outlook.Application
    Dim objItem As Object
    Dim objMailItem As Outlook.MailItem
    
    Set objApp = Outlook.Application
    
    If (Not objApp.ActiveExplorer Is Nothing) Then
        For Each objItem In objApp.ActiveExplorer.Selection
            If (Not objItem Is Nothing And TypeName(objItem) = "MailItem") Then
                Set objMailItem = objItem
                eBayReminder objMailItem
            End If
        Next
        Set objItem = Nothing
        Set objMailItem = Nothing
    End If
    Set objApp = Nothing
End Sub

Open in new window

0
 
jglazer63Author Commented:
One note, set TZDiff to whatever the difference is between EBay's actual time zone and your own.  Note that its set to 3 right now since I am eastern (3 hour difference)

0
 
DonPhillipeCommented:
Thanks!  This will let me review some old VB skills, or lack of.   First off, I have tried Redemption before several times but abandoned it because of the security warnings and problems with that area.  I see you get around it now via the digital certificate.  Good info and maybe this will allow me to play with some things I wanted to do in this area.  For someone who has played with VB6, the Outlook VM editor doesnt make much sense &.

I used the MS Office tools to create the digital certificate OK.
Outlook 2003, Tools, Macros, VB Editor .... I see a Project1 (VbaProject.OTM) with a file tree below, Microsoft Office Outlok Objects.  I can only find the option Insert, Module where I select this option and paste the routines contents into the frame.  I of course comment out the first line '----- and since the last line "Open in New Window" gives me a red-line, I have commented that out too 'Open in New Window (not sure what that is for?).

After pasting in the BAS file contents, I now have a "Modules" high-level folder under Project1 tree and a "Module1" under the master Module, with the contents of  eBayReminder.bas file.  I don't see a File, Save option under Microsfot Visual Basic - VbaProject.OTM window so I simply close it.  I don't get a prompt of any kind when I close up the VB editor asking me to save it when I close it either.

Now I go to Outlook, Tools, Macros and I find an entry called TestIt in my list.  Not sure where that name came from other than perhaps years ago I may have been here before :-).  When I edit TestIt from the Macros list, I see the same editor screen where I just added the Module1 with eBayReminder.bas contents.  (Confused where this TestIt macro name came from.)  I never encountered an option to name this code?  [OK, maybe I don't understand the concept of Outlook VB editor, maybe code entered here just lingers somewhere in the background and I don't have to save it or name it anything.  If this is true, my mind begins to wonder how one saves multiple routines that don't interfere with each other ...]

Maybe I found the answer.  I assume this code just lingers somewhere in Outlook's memory somewhere.  I just now rebooted and started Outlook and this time it asked me to accept the Digital Certificate I just created.  Maybe this is because I didn't reboot after installing Redemption?  

I put my questions aside about saving and naming and continued on with making the rule to try to call the code.  After creating the rule and rebooting, it appears the script is working.  It kicks off when I get an email from my ID on eBay but after getting this far, I get an error message that says "Could not create eBay appt.  Could not figure out Item Number".  

Thanks for taking time to explain this.  I appreciate it!

Opps!!!   After I cleared the warning message saying it could not create eBay appt, it deleted both the email from eBay and all the items I had received after it in my incoming list.   I am on IMAP so I was able to undelete them and not lose anything.  

0
 
DonPhillipeCommented:
Oh, I see the answer to one of my questions, that is where the extra line of text came from.  When you drag through the code text box above and CTL-C, then paste the code into a Notepad screen, the copy has somehow picked up a line that was not visible, "Open in New Window".  Odd.  (Try it, drag through the code in the example, CTL+C, then CTL+V into Notepad and an extra line of text shows up at the bottom, the line "Open in New Window".
0
 
jglazer63Author Commented:
So did you resolve it?  There is a function called TestIt that is just that, to test the code. You can comment out the delete email line if you wish to try to debug it.  This does work but takes some playing with now and then as they reformat their messages.

Hope this helps!
0
 
DonPhillipeCommented:
I uncommented your WriteToFile line and this is the test.txt entry it made.  It looks like Redemption is not pulling all the text out of the body for some reason.
File: test.txt on D:\ drive: 
 
eBay	
 	An eBay member wants to show you this item	 	
	
Hi, I saw this item on eBay and thought you might be interested. 
 
 
 	
Black Minolta Toner EP-4320 5320 5400 5420 5425 NEW!	Black Minolta Toner EP-4320 5320 5400 5420 5425 NEW!	
Buy It Now price:	$6.99 Buy It Now
End time:	Aug-23-08 14:53:02 PDT	
Add to watch list | See similar items	
Check out this item
 	
 
 
 
 
  _____  
 
Learn More to protect yourself from spoof (fake) emails.
 
This email sent through the eBay platform from a sender who thinks you are likely to be interested in this information. eBay takes no liability for sending this email or its content.
 
You can report this message as unsolicited (spam/spoof) email.
 
Copyright © 2008 eBay Inc. All Rights Reserved. Designated trademarks and brands are the property of their respective owners. eBay and the eBay logo are trademarks of eBay Inc. eBay Inc. is located at 2145 Hamilton Avenue, San Jose, CA 95125. 	

Open in new window

0
 
jglazer63Author Commented:
Yea doesn't look right to me either.  This is what it looks like for me.  Note the HTML in it.  If yours looks like that you'll need to futz with the code some to pull out the relavent info.
 eBay<http://pics.ebaystatic.com/aw/pics/logos/ebay_95x39.gif> 	
 <http://pics.ebaystatic.com/aw/pics/globalAssets/ltCurve.gif> 	An eBay member wants to show you this item	 <http://pics.ebaystatic.com/aw/pics/globalAssets/rtCurve.gif> 	
	
Hi, I saw this item on eBay and thought you might be interested. 
 
 
 <http://pics.ebaystatic.com/aw/pics/s.gif> 	
Craftsman 6HP, 30 Gal Tank Air Compressor w\ 50ft Hose <http://cgi.ebay.com/ws/eBayISAPI.dll?ViewItem&item=330244655766&ssPageName=ADME:B:EF:US:1123> 	Craftsman 6HP, 30 Gal Tank Air Compressor w\ 50ft Hose <http://cgi.ebay.com/ws/eBayISAPI.dll?ViewItem&item=330244655766&ssPageName=ADME:B:EF:US:1123> 	
Current price:	$95.99 
End time:	Jun-22-08 10:08:58 PDT	
Add to watch list <http://cgi1.ebay.com/ws/eBayISAPI.dll?MakeTrack&item=330244655766&ssPageName=ADME:B:EF:US:1153>  | See similar items <http://search.ebay.com/Craftsman-6HP-30-Gal-Tank-Air-Compressor-w-50ft-Hose_W0QQsacatZ22662?&ssPageName=ADME:B:EF:US:1114> 	
Check out this item
 <http://pics.ebaystatic.com/aw/pics/s.gif> 	
 <http://cgi.ebay.com/ws/eBayISAPI.dll?ViewItem&&item=330244655766&ssPageName=ADME:B:EF:US:1120> 
 
 
 
________________________________
 
Learn More <http://pages.ebay.com/education/spooftutorial/index.html>  to protect yourself from spoof (fake) emails.
 
This email sent through the eBay platform from a sender who thinks you are likely to be interested in this information. eBay takes no liability for sending this email or its content.
 
You can report this message <http://pages.ebay.com/help/policies/rfe-spam-ov.html>  as unsolicited (spam/spoof) email.
 
Copyright © 2008 eBay Inc. All Rights Reserved. Designated trademarks and brands are the property of their respective owners. eBay and the eBay logo are trademarks of eBay Inc. eBay Inc. is located at 2145 Hamilton Avenue, San Jose, CA 95125. 	

Open in new window

0
 
DonPhillipeCommented:
........
  Body = sItem.Body
  WriteToFile (Body) ' ****  test line of code
  BodyLines = Split(Body, vbCrLf)
  Set sItem = Nothing
..............
 
I'll take it up with the Redemption developer and see what he has to say, thanks.
0
 
DonPhillipeCommented:
I am using Outlook 2003, SP3 on Win XP SP3 with the latest version of Redemption, developer edition.
0
 
jglazer63Author Commented:
Sounds right.  Thats what I'm using.
0
 
DonPhillipeCommented:
Is your Outlook configured as POP3, Exchange or IMAP?  I have 1 IMAP and 1 Hotmail account configured when I test this code.   I don't have any POP3 accounts I can test (because it would eat all the email off the server).
0

Featured Post

[Webinar] Improve your customer journey

A positive customer journey is important in attracting and retaining business. To improve this experience, you can use Google Maps APIs to increase checkout conversions, boost user engagement, and optimize order fulfillment. Learn how in this webinar presented by Dito.

  • 7
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now