Help with VBA code - Created by Sue Mosher

  • Thread starter Thread starter Rafael
  • Start date Start date
R

Rafael

If I remember correctly, the original code to perform this function was
created by Sue Mosher. If that's not the case please accept my apologies
Sue!

I use this code to retrieve certain information from the body of a contact
(vCard file). The only issue is that it will not work after the fourth line
of text. If the label I'm looking for is located on a the 5th, or 6th, line,
an error (Type Mismatch) is return on this line: intLocLabel =
Mid(strSource, intLocLabel + intLenLabel).

It works great for the first 4 lines however (lines = Name:, Company:,
Company Size:, JobTitle:, Comments:).

Just wondering if this can be fixed and how.

Function CoSize(strSource As String, strLabel As String)
Set myOlApp = CreateObject("Outlook.Application")
Set olns = myOlApp.GetNamespace("MAPI")
Set myItem = myOlApp.ActiveInspector.CurrentItem
'Set myInbox = olns.PickFolder
'Set myItems = myInbox.Items
Dim intLocLabel As Integer
Dim intLocCRLF As Integer
Dim intLenLabel As Integer
Dim strText As String
strSource = myItem.Body
' MsgBox strSource
'intLocLabel = "To:"
'intLocLabel = InStr(strSource, strLabel)
intLocLabel = InStr(strSource, "Company size:")
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
CoSize = Trim(strText)
Set myOlApp = Nothing
Set olns = Nothing
Set myItem = Nothing
End Function

Thanks,

Rafael
 
The Mid() function returns a string, and intLocLabel is an integer -
thus the type mismatch. I'll bet that line should read:

strText = Mid(strSource, intLocLabel + intLenLabel)

-jcf

| If I remember correctly, the original code to perform this function
was
| created by Sue Mosher. If that's not the case please accept my
apologies
| Sue!
|
| I use this code to retrieve certain information from the body of a
contact
| (vCard file). The only issue is that it will not work after the
fourth line
| of text. If the label I'm looking for is located on a the 5th, or
6th, line,
| an error (Type Mismatch) is return on this line: intLocLabel =
| Mid(strSource, intLocLabel + intLenLabel).
|
| It works great for the first 4 lines however (lines = Name:,
Company:,
| Company Size:, JobTitle:, Comments:).
|
| Just wondering if this can be fixed and how.
|
| Function CoSize(strSource As String, strLabel As String)
| Set myOlApp = CreateObject("Outlook.Application")
| Set olns = myOlApp.GetNamespace("MAPI")
| Set myItem = myOlApp.ActiveInspector.CurrentItem
| 'Set myInbox = olns.PickFolder
| 'Set myItems = myInbox.Items
| Dim intLocLabel As Integer
| Dim intLocCRLF As Integer
| Dim intLenLabel As Integer
| Dim strText As String
| strSource = myItem.Body
| ' MsgBox strSource
| 'intLocLabel = "To:"
| 'intLocLabel = InStr(strSource, strLabel)
| intLocLabel = InStr(strSource, "Company size:")
| 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
| CoSize = Trim(strText)
| Set myOlApp = Nothing
| Set olns = Nothing
| Set myItem = Nothing
| End Function
|
| Thanks,
|
| Rafael
|
|
 
I'll double-or-nothing my bet: I'll bet the problem happens when the
label you're looking for is on the LAST line, regardless of which line
number it is.

-jcf

| Your bet was well placed. It worked!
|
| Thanks,
|
| Rafael
|
| | > The Mid() function returns a string, and intLocLabel is an
integer -
| > thus the type mismatch. I'll bet that line should read:
| >
| > strText = Mid(strSource, intLocLabel + intLenLabel)
| >
| > -jcf
| >
| > | > | If I remember correctly, the original code to perform this
function
| > was
| > | created by Sue Mosher. If that's not the case please accept my
| > apologies
| > | Sue!
| > |
| > | I use this code to retrieve certain information from the body of
a
| > contact
| > | (vCard file). The only issue is that it will not work after the
| > fourth line
| > | of text. If the label I'm looking for is located on a the 5th,
or
| > 6th, line,
| > | an error (Type Mismatch) is return on this line: intLocLabel =
| > | Mid(strSource, intLocLabel + intLenLabel).
| > |
| > | It works great for the first 4 lines however (lines = Name:,
| > Company:,
| > | Company Size:, JobTitle:, Comments:).
| > |
| > | Just wondering if this can be fixed and how.
| > |
| > | Function CoSize(strSource As String, strLabel As String)
| > | Set myOlApp = CreateObject("Outlook.Application")
| > | Set olns = myOlApp.GetNamespace("MAPI")
| > | Set myItem = myOlApp.ActiveInspector.CurrentItem
| > | 'Set myInbox = olns.PickFolder
| > | 'Set myItems = myInbox.Items
| > | Dim intLocLabel As Integer
| > | Dim intLocCRLF As Integer
| > | Dim intLenLabel As Integer
| > | Dim strText As String
| > | strSource = myItem.Body
| > | ' MsgBox strSource
| > | 'intLocLabel = "To:"
| > | 'intLocLabel = InStr(strSource, strLabel)
| > | intLocLabel = InStr(strSource, "Company size:")
| > | 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
| > | CoSize = Trim(strText)
| > | Set myOlApp = Nothing
| > | Set olns = Nothing
| > | Set myItem = Nothing
| > | End Function
| > |
| > | Thanks,
| > |
| > | Rafael
| > |
| > |
| >
|
|
 
That's also a good bet. :)

John Ford said:
I'll double-or-nothing my bet: I'll bet the problem happens when the
label you're looking for is on the LAST line, regardless of which line
number it is.

-jcf

| Your bet was well placed. It worked!
|
| Thanks,
|
| Rafael
|
| | > The Mid() function returns a string, and intLocLabel is an
integer -
| > thus the type mismatch. I'll bet that line should read:
| >
| > strText = Mid(strSource, intLocLabel + intLenLabel)
| >
| > -jcf
| >
| > | > | If I remember correctly, the original code to perform this
function
| > was
| > | created by Sue Mosher. If that's not the case please accept my
| > apologies
| > | Sue!
| > |
| > | I use this code to retrieve certain information from the body of
a
| > contact
| > | (vCard file). The only issue is that it will not work after the
| > fourth line
| > | of text. If the label I'm looking for is located on a the 5th,
or
| > 6th, line,
| > | an error (Type Mismatch) is return on this line: intLocLabel =
| > | Mid(strSource, intLocLabel + intLenLabel).
| > |
| > | It works great for the first 4 lines however (lines = Name:,
| > Company:,
| > | Company Size:, JobTitle:, Comments:).
| > |
| > | Just wondering if this can be fixed and how.
| > |
| > | Function CoSize(strSource As String, strLabel As String)
| > | Set myOlApp = CreateObject("Outlook.Application")
| > | Set olns = myOlApp.GetNamespace("MAPI")
| > | Set myItem = myOlApp.ActiveInspector.CurrentItem
| > | 'Set myInbox = olns.PickFolder
| > | 'Set myItems = myInbox.Items
| > | Dim intLocLabel As Integer
| > | Dim intLocCRLF As Integer
| > | Dim intLenLabel As Integer
| > | Dim strText As String
| > | strSource = myItem.Body
| > | ' MsgBox strSource
| > | 'intLocLabel = "To:"
| > | 'intLocLabel = InStr(strSource, strLabel)
| > | intLocLabel = InStr(strSource, "Company size:")
| > | 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
| > | CoSize = Trim(strText)
| > | Set myOlApp = Nothing
| > | Set olns = Nothing
| > | Set myItem = Nothing
| > | End Function
| > |
| > | Thanks,
| > |
| > | Rafael
| > |
| > |
| >
|
|
Click to expand...
 
Back
Top