Attribute VB_Name = "Module1"
' Outlook label printing for Atomic Avenue
' by Peter Bickford
' ©2007 Atomic Avenue, Inc.
'
' Dymo label code used here is part of the Dymo SDK and is © Dymo
'
' This code can be used to automatically print a shipping label on your
' Dymo label printer for Atomic Avenue orders. Ideally, it will be used
' in conjunction with a Mail Rule to trigger the printing automatically
' when a new order comes in.
'
' Requires the Redemption library to be installed and referenced
' on your machine, as well as the Dymo SDK for Windows. Also requires
' the desired label file be installed as:
' C:\Documents and Settings\All Users\Documents\DYMO Label\Label Files\Atomic Avenue Sale.LWL
'
' Be sure to read the full instructions for using this at
' http://www.atomicavenue.com/community/Atomic_Avenue_Label_Printing.asp
'
' Please report any bugs or problems with this code to
'   support@atomicavenue.com



Option Explicit
Option Compare Text

'OLE objects used to communicate with DLS
Dim IDymoAddIn As Object
Dim IDymoLabels As Object


Public Sub ProcessThisMessage(objMsg As MailItem)

' Processes a single message. Used when being called from a mail-receiving macro

Dim objSafeMsg As Redemption.SafeMailItem

  If Left(objMsg.Subject, Len("Atomic Avenue Order #")) = "Atomic Avenue Order #" And _
     Right(objMsg.Subject, Len("Ship Now")) = "Ship Now" Then
    ' Create a "Safe" version of the selected mail message using
    ' Redemption, so that we don't trigger Outlook's virus message
    Set objSafeMsg = CreateObject("Redemption.SafeMailItem")
    objSafeMsg.Item = objMsg

    ProcessAtomicAvenueOrder objSafeMsg
  End If
  
End Sub



Public Sub ProcessMessages()

' Processes the selected messages. Useful if the message(s) are specifically
' selected by the user for printing/reprinting

Dim objApp As Outlook.Application
Dim objSel As Outlook.Selection
Dim x As Integer
Dim objSafeMsg As Redemption.SafeMailItem

  Set objApp = CreateObject("Outlook.Application")
  Set objSel = objApp.ActiveExplorer.Selection

  If objSel.Count = 0 Then
    MsgBox "No items were selected"
  Else
    For x = 1 To objSel.Count
      If Left(objSel.Item(x).Subject, Len("Atomic Avenue Order #")) = "Atomic Avenue Order #" And _
        Right(objSel.Item(x).Subject, Len("Ship Now")) = "Ship Now" Then
        ' Create a "Safe" version of the selected mail message using
        ' Redemption, so that we don't trigger Outlook's virus message
        Set objSafeMsg = CreateObject("Redemption.SafeMailItem")
        objSafeMsg.Item = objSel.Item(x)
      
        ProcessAtomicAvenueOrder objSafeMsg
      End If
    Next x
  End If
    
  Set objApp = Nothing
  Set objSel = Nothing
End Sub


Public Sub ProcessAtomicAvenueOrder(theMessage As SafeMailItem)
  
' Prints a customized label using data from this mail message

Dim curName As String
Dim orderNumber As String
  
  ' Pull off the order number from the packing slip message
  orderNumber = LineAfterKeyword("Order #", theMessage.Body)
  
  ' Find the ship-to-name from the packing slip
  Dim curNamePos As String
  curNamePos = InStr(theMessage.HTMLBody, "<br/><br/><hr><br/>") + Len("<br/><br/><hr><br/>")
  Dim Pos2 As String
  Pos2 = InStr(curNamePos + 1, theMessage.HTMLBody, "<br/><br/><hr><br/>")
  curName = Replace(Mid(theMessage.HTMLBody, curNamePos, Pos2 - curNamePos), "<br/>", vbCrLf)
  
  ' Print the label -- Change the path here if you've installed your label in a different location
  InitLabel "C:\Documents and Settings\All Users\Documents\DYMO Label\Label Files\Atomic Avenue Sale.LWL"
  
  Dim MaxN As Integer, N As Integer

  IDymoLabels.setfield "Address", curName
  MaxN = IDymoLabels.AddressFieldCount
  If MaxN = 0 Then
    MsgBox "There is no address field on the label."
  Else
      'set address
      IDymoLabels.SetAddress N, curName
      'set POSTNET barcode position
      IDymoLabels.PostNet N, "Bottom"
      
        IDymoLabels.setfield "Order", orderNumber
        
      ' Specially tag out Expedited orders at the top-right of the label
      If InStr(theMessage.Body, "Shipment should be made via Expedited Shipping to:") > 0 Then
        IDymoLabels.setfield "OrderNum", "EXPEDITED: Atomic Avenue Order #" & orderNumber
      Else
          IDymoLabels.setfield "OrderNum", "Atomic Avenue Order #" & orderNumber
      End If
   End If

  PrintLabel
  CloseLabel
End Sub


' -----------------------------------
' Create our OLE objects
' return TRUE on success
' -----------------------------------
Function CreateOLEObjects() As Boolean
    On Error GoTo CANNOTCREATE
    CreateOLEObjects = True
    Set IDymoAddIn = CreateObject("Dymo.DymoAddIn")
    Set IDymoLabels = CreateObject("Dymo.DymoLabels")
    'if both OLE objects successfully created then exit the subroutine
    If Not (IDymoAddIn Is Nothing) And Not (IDymoLabels Is Nothing) Then Exit Function
CANNOTCREATE:
    MsgBox "Unable to create OLE objects"
    CreateOLEObjects = False
End Function



' -----------------------------------
' Create OLE objects to communicate with Dymo Label
' -----------------------------------
Private Sub InitLabel(ByVal labelFile As String)
    CreateOLEObjects
    IDymoAddIn.hide
    IDymoAddIn.SysTray False

    IDymoAddIn.Open labelFile
    ' UpdateListButton_Click 'update available fields
End Sub


' -----------------------------------
' Print a Label
' -----------------------------------
Private Sub PrintLabel()
    'Print 1 copy and display print progress dialog
    Dim q
    q = IDymoAddIn.Print(1, True)
End Sub

Private Sub CloseLabel()
    Set IDymoAddIn = Nothing
    Set IDymoLabels = Nothing
End Sub

' -----------------------------------
' Update address-field by user-defined data
' -----------------------------------
Private Sub UpdateAddress(theAddress As String, ByVal orderNum As String)
Dim MaxN As Integer, N As Integer

  IDymoLabels.setfield "Address", theAddress
    MaxN = IDymoLabels.AddressFieldCount
    If MaxN = 0 Then
        MsgBox "There is no address field on the label."
    Else
      'set address
      IDymoLabels.SetAddress N, theAddress
      'set POSTNET barcode position
      IDymoLabels.PostNet N, "Bottom"
      
      If orderNum > "" Then
        IDymoLabels.setfield "OrderNum", orderNum
      End If
    End If
End Sub


Public Function GetLine(theString As String, startingPos As Long)

' Returns the text from the starting point to the end of the line

Dim x As Long
Dim curChar As String
Dim destString As String
Dim done As Boolean

  done = False
  x = startingPos
  destString = ""
  If startingPos >= Len(theString) Then
    GetLine = ""
  Else
    While Not done And x <= Len(theString)
      curChar = Mid(theString, x, 1)
      If curChar = vbCr Or curChar = vbLf Then
        done = True
      Else
        x = x + 1
        destString = destString & curChar
      End If
    Wend
    GetLine = Trim(destString)
  End If
End Function


Public Function LineAfterKeyword(myKeyword As String, _
  theString As String)
  
' returns the characters from where a phrase was found in theString,
' up until the end of that line

Dim foundPos As Long
Dim destLine As String

  foundPos = InStr(theString, myKeyword)
  If foundPos < 1 Then
    LineAfterKeyword = ""
  Else
    destLine = GetLine(theString, foundPos)
    If Len(myKeyword) > Len(destLine) Then
      LineAfterKeyword = ""
    Else
      LineAfterKeyword = Right(destLine, Len(destLine) - Len(myKeyword))
    End If
  End If
End Function




