Hi all
I have untidily stitched 2 pieces of code together: the 1st taken from elsewhere in this forum (the idea of including a button is exactly how i want to use this code - have the button set up already); the second is taken from a Sue Mosher piece about Parsing text.
Put simply I want to process an 'enquiry form' email after I have read it by clicking a button which copies name and address details etc over to specified excel workbook cells (which are key to further processes in my CRM).
Here is the form I receive:
name: Sammy Snake
address: Serpent Wynd
town: Adder Water
postcode: SN4 4ES
email: sammy@thesnake.com
phone: 00000000000
heardfrom: Homes and Interiors Scotland
HTTP User Agent: Mozilla/5.0 (Windows NT 6.0; rv:2.0.1) Gecko/20100101 Firefox/4.0.1
Date: 18 June 2011
Time: 13:18
furthercomments:
Hello ssssssssonny
Here is the code I have: it throws up a "Compile Error: ByRef argument type mismatch" @
strBody = out_mail.body
strName = ParseTextLinePair(strBody, "name: ")
this is the code where I need to mesh the two elements together to work in tandem.
Function ParseTextLinePair(strSource As String, strLabel As String)
Dim intLocLabel As Integer
Dim intLocCRLF As Integer
Dim intLenLabel As Integer
Dim strText As String
' locate the label in the source text
intLocLabel = InStr(strSource, strLabel)
intLenLabel = Len(strLabel)
If intLocLabel > 0 Then
intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
If intLocCRLF > 0 Then
intLocLabel = intLocLabel + intLenLabel
strText = Mid(strSource, _
intLocLabel, _
intLocCRLF - intLocLabel)
Else
intLocLabel = Mid(strSource, intLocLabel + intLenLabel)
End If
End If
ParseTextLinePair = Trim(strText)
End Function
Sub NewEnquiry()
Dim xlApp As Object ' Excel.Application
Dim xlWkb As Object ' Excel.Workbook
Dim out_app As Outlook.Application
Dim out_Exp As Outlook.Explorer
Dim out_Sel As Outlook.Selection
Dim out_mail As Outlook.MailItem
Set out_app = Application
'get the active explorer
Set out_Exp = out_app.ActiveExplorer
'
If out_Exp.CurrentFolder.WebViewOn = False Then
Set out_Sel = out_Exp.Selection
Else
MsgBox "wrong item type"
Set out_Exp = Nothing
Exit Sub
End If
''first make sure they have only choosen one item if not exit sub
If out_Sel.Count > 1 Then
MsgBox "more than one item"
Exit Sub
Else
If out_Sel.Count = 0 Then
MsgBox "nothing choosen"
Exit Sub
End If
End If
'
''check that it is in fact an email that has been choosen
If Not out_Sel.item(1).Class = olMail Then
MsgBox "not an email"
Exit Sub
End If
'
'
'next try to get the email item - if there is an error 13 then it is encrypted - you may not need this one
On Error Resume Next
Set out_mail = out_Sel.item(1)
If Err.Number = 13 Then
Err.Clear
MsgBox "email encrypted"
Exit Sub
End If
strBody = out_mail.body
strName = ParseTextLinePair(strBody, "name: ")
strAddress = ParseTextLinePair(strBody, "address: ")
strTown = ParseTextLinePair(strBody, "town: ")
strPostcode = ParseTextLinePair(strBody, "postcode: ")
strEmail = ParseTextLinePair(strBody, "email: ")
strPhone = ParseTextLinePair(strBody, "phone: ")
Set xlApp = CreateObject("Excel.Application") ' New Excel.Application
Set xlWkb = xlApp.Workbooks.Open("C:\Users\Jimmy Riddle\Desktop\CLIENT SOURCE DATA.xlsm")
xlApp.Visible = True
With xlWkb.Sheets("SourceData")
.Range("b1").Value = strName
.Range("b2").Value = strAddress
.Range("b3").Value = strTown
.Range("b5").Value = strPostcode
.Range("b7").Value = strPhone
.Range("c2").Value = strEmail
End With
Set xlApp = Nothing
Set xlWkb = Nothing
End Sub
Clearly I am no expert and there may be serious and obvious errors that I am otherwise unaware of but any advice will be very warmly received!
Bookmarks