This is driving me nuts. I have some code that runs right every second time
and I can't figure out why!

The purpose of the code is to automatically address and format an e-mail
message from a button on an MS Access card. The code correctly takes the
name of the addressee from the card, and the inserts it and the contents of
the Re: line. It then inserts an additional two or three lines of
information from the Access card into the message field.

The next step in the code is to insert a signature file entitled
"letterhead" which is a graphic of our letterhead above the three lines of
text in the message field. The next part of the codes moves the cursor down
below the text and is supposed to insert a second signature file, this time
called "full signature" at the bottom of the message which includes the name
of the sender and some sender specific information. The two signature files
are simply in the Outlook appliction and are named "letterhead" and "full
signature".

Everything works perfectly except that every second time the code is run (by
clicking on the button on the Access card), the code inserts the
"letterhead" signature at the bottom instead of the "full signature", so we
end up with the "letterhead signature" twice (at the top and bottom) and no
"full signature".

Any help would be appreciated. The code is as follows:

-------------------

Dim olApp As Object
Dim objNewMail As Object
Dim objONewmail As Object
Dim AddressString As String, SubjectString As String
Dim bodystring1 As String, bodystring2 As String, bodystring3 As String
Set olApp = New Outlook.Application
Set objONewmail = olApp.CreateItem(olMailItem)
Set objNewMail = CreateObject("REDEMPTION.SafeMailItem") 'Circumvents
Outlook Security Patch
objNewMail.Item = objONewmail
With objNewMail
'Gets various information from MS Access and inserts it
into a mail message:
AddressString = CStr(Me![email])
SubjectString = CStr([File Name])
bodystring1 = "Our File Number: " & CStr([File Number]) & Chr(10)
bodystring2 = ""
bodystring3 = ""
If IsNull(Me![Claimno]) = 0 Then bodystring2 = "Your Claim Number: " &
CStr(Me![Claimno]) & Chr(10)
If IsNull(Me![DateLoss]) = 0 Then bodystring3 = "Date of Loss: " &
CStr(Me![DateLoss]) & Chr(10)

bodystring1 = bodystring1 & bodystring2 & bodystring3 &
"-------------------------" & Chr(10) & Chr(10) & Chr(10)
..Recipients.Add AddressString
..Recipients.ResolveAll
..Subject = SubjectString
..Body = bodystring1
..Display


'The next section inserts the "letterhead" signature file above
the three lines of text in the body of the message:

Dim objOutlook As Outlook.Application
Dim ObjCtl As Office.CommandBarControl
Dim ObjPop As Office.commandBarPopup
Dim ObjCB As Office.CommandBar
Dim ObjItem As Object

Set objOutlook = CreateObject("Outlook.Application")
Set ObjCB = objOutlook.ActiveInspector.CommandBars("Menu Bar")
Set ObjPop = ObjCB.Controls("Insert")
Set ObjPop = ObjPop.Controls("Signature")
Set ObjCtl = ObjPop.Controls.Item("letterhead")
ObjCtl.Execute
Set objOutlook = Nothing
Set ObjCtl = Nothing
Set ObjPop = Nothing
Set ObjCB = Nothing
Set ObjItem = Nothing

'Next section moves Cursor to bottom of message before inserting signature


x = 6
Dim sInspector
Dim plaintexteditor
Set sInspector = CreateObject("Redemption.SafeInspector")
sInspector.Item = Outlook.ActiveInspector
Set plaintexteditor = sInspector.plaintexteditor
plaintexteditor.CaretPosY = x

'The next section inserts the "full signature" signature file at the
bottom of the message

Dim objOutlook2 As Outlook.Application
Dim ObjCtl2 As Office.CommandBarControl
Dim ObjPop2 As Office.commandBarPopup
Dim ObjCB2 As Office.CommandBar
Dim ObjItem2 As Object

Set objOutlook2 = CreateObject("Outlook.Application")
Set ObjCB2 = objOutlook2.ActiveInspector.CommandBars("Menu Bar")
Set ObjPop2 = ObjCB2.Controls("Insert")
Set ObjPop2 = ObjPop2.Controls("Signature")
Set ObjCtl2 = ObjPop2.Controls.Item("Full Signature")
Set ObjCtl2 = ObjPop2.Controls.Item("Full Signature")
ObjCtl2.Execute

Set objOutlook2 = Nothing
Set ObjCtl2 = Nothing
Set ObjPop2 = Nothing
Set ObjCB2 = Nothing
Set ObjItem2 = Nothing


'resets the cursor position to above the signature for text entry
x = 6
If IsNull(Me![Claimno]) = True Then x = x - 1
If IsNull(Me![DateLoss]) = True Then x = x - 1
'Dim sInspector
'Dim plaintexteditor
Set sInspector = CreateObject("Redemption.SafeInspector")
sInspector.Item = Outlook.ActiveInspector
Set plaintexteditor = sInspector.plaintexteditor
plaintexteditor.CaretPosY = x

End With

Dim utils
Set utils = CreateObject("Redemption.MAPIUtils")


Exit Sub

--
____________________
John Strung
Ancaster, Ontario, Canada
_____________________

Am Wed, 12 Oct 2005 13:54:25 -0400 schrieb John Strung:

John, I don´t know if this can help to solve your problem but why do try to
create three times the Outlook Application within one function?

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook

> This is driving me nuts. I have some code that runs right every second
time
> and I can't figure out why!
>
> The purpose of the code is to automatically address and format an e-mail
> message from a button on an MS Access card. The code correctly takes the
> name of the addressee from the card, and the inserts it and the contents
of
> the Re: line. It then inserts an additional two or three lines of
> information from the Access card into the message field.
>
> The next step in the code is to insert a signature file entitled
> "letterhead" which is a graphic of our letterhead above the three lines of
> text in the message field. The next part of the codes moves the cursor
down
> below the text and is supposed to insert a second signature file, this
time
> called "full signature" at the bottom of the message which includes the
name
> of the sender and some sender specific information. The two signature
files
> are simply in the Outlook appliction and are named "letterhead" and "full
> signature".
>
> Everything works perfectly except that every second time the code is run
(by
> clicking on the button on the Access card), the code inserts the
> "letterhead" signature at the bottom instead of the "full signature", so
we
> end up with the "letterhead signature" twice (at the top and bottom) and
no
> "full signature".
>
> Any help would be appreciated. The code is as follows:
>
> -------------------
>
> Dim olApp As Object
> Dim objNewMail As Object
> Dim objONewmail As Object
> Dim AddressString As String, SubjectString As String
> Dim bodystring1 As String, bodystring2 As String, bodystring3 As String
> Set olApp = New Outlook.Application
> Set objONewmail = olApp.CreateItem(olMailItem)
> Set objNewMail = CreateObject("REDEMPTION.SafeMailItem") 'Circumvents
> Outlook Security Patch
> objNewMail.Item = objONewmail
> With objNewMail
> 'Gets various information from MS Access and inserts it
> into a mail message:
> AddressString = CStr(Me![email])
> SubjectString = CStr([File Name])
> bodystring1 = "Our File Number: " & CStr([File Number]) & Chr(10)
> bodystring2 = ""
> bodystring3 = ""
> If IsNull(Me![Claimno]) = 0 Then bodystring2 = "Your Claim Number: " &
> CStr(Me![Claimno]) & Chr(10)
> If IsNull(Me![DateLoss]) = 0 Then bodystring3 = "Date of Loss: " &
> CStr(Me![DateLoss]) & Chr(10)
>
> bodystring1 = bodystring1 & bodystring2 & bodystring3 &
> "-------------------------" & Chr(10) & Chr(10) & Chr(10)
> .Recipients.Add AddressString
> .Recipients.ResolveAll
> .Subject = SubjectString
> .Body = bodystring1
> .Display
>
>
> 'The next section inserts the "letterhead" signature file above
> the three lines of text in the body of the message:
>
> Dim objOutlook As Outlook.Application
> Dim ObjCtl As Office.CommandBarControl
> Dim ObjPop As Office.commandBarPopup
> Dim ObjCB As Office.CommandBar
> Dim ObjItem As Object
>
> Set objOutlook = CreateObject("Outlook.Application")
> Set ObjCB = objOutlook.ActiveInspector.CommandBars("Menu Bar")
> Set ObjPop = ObjCB.Controls("Insert")
> Set ObjPop = ObjPop.Controls("Signature")
> Set ObjCtl = ObjPop.Controls.Item("letterhead")
> ObjCtl.Execute
> Set objOutlook = Nothing
> Set ObjCtl = Nothing
> Set ObjPop = Nothing
> Set ObjCB = Nothing
> Set ObjItem = Nothing
>
> 'Next section moves Cursor to bottom of message before inserting signature
>
>
> x = 6
> Dim sInspector
> Dim plaintexteditor
> Set sInspector = CreateObject("Redemption.SafeInspector")
> sInspector.Item = Outlook.ActiveInspector
> Set plaintexteditor = sInspector.plaintexteditor
> plaintexteditor.CaretPosY = x
>
> 'The next section inserts the "full signature" signature file at the
> bottom of the message
>
> Dim objOutlook2 As Outlook.Application
> Dim ObjCtl2 As Office.CommandBarControl
> Dim ObjPop2 As Office.commandBarPopup
> Dim ObjCB2 As Office.CommandBar
> Dim ObjItem2 As Object
>
> Set objOutlook2 = CreateObject("Outlook.Application")
> Set ObjCB2 = objOutlook2.ActiveInspector.CommandBars("Menu Bar")
> Set ObjPop2 = ObjCB2.Controls("Insert")
> Set ObjPop2 = ObjPop2.Controls("Signature")
> Set ObjCtl2 = ObjPop2.Controls.Item("Full Signature")
> Set ObjCtl2 = ObjPop2.Controls.Item("Full Signature")
> ObjCtl2.Execute
>
> Set objOutlook2 = Nothing
> Set ObjCtl2 = Nothing
> Set ObjPop2 = Nothing
> Set ObjCB2 = Nothing
> Set ObjItem2 = Nothing
>
>
> 'resets the cursor position to above the signature for text entry
> x = 6
> If IsNull(Me![Claimno]) = True Then x = x - 1
> If IsNull(Me![DateLoss]) = True Then x = x - 1
> 'Dim sInspector
> 'Dim plaintexteditor
> Set sInspector = CreateObject("Redemption.SafeInspector")
> sInspector.Item = Outlook.ActiveInspector
> Set plaintexteditor = sInspector.plaintexteditor
> plaintexteditor.CaretPosY = x
>
> End With
>
> Dim utils
> Set utils = CreateObject("Redemption.MAPIUtils")
>
>
> Exit Sub

Ignorance is my only excuse, Michael. I have now corrected that, but it
doesn't seem to have solved the problem I was having.

"Michael Bauer" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> Am Wed, 12 Oct 2005 13:54:25 -0400 schrieb John Strung:
>
> John, I don´t know if this can help to solve your problem but why do try
> to
> create three times the Outlook Application within one function?

Am Thu, 13 Oct 2005 09:18:09 -0400 schrieb John Strung:

Your shown code seems to be ok. Did you check that ObjCtl2 really points to
the proper CommandBarButton?

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook

> Ignorance is my only excuse, Michael. I have now corrected that, but it
> doesn't seem to have solved the problem I was having.
>
> "Michael Bauer" <(E-Mail Removed)> wrote in message
> news:(E-Mail Removed)...
>> Am Wed, 12 Oct 2005 13:54:25 -0400 schrieb John Strung:
>>
>> John, I don´t know if this can help to solve your problem but why do try
>> to
>> create three times the Outlook Application within one function?

Yes. I ran a watch and stepped through the code. It always points to "Full
Signature", even when it inserts "Letterhead". The odd thing is that it
works every second time. It is not random.

"Michael Bauer" <(E-Mail Removed)> wrote in message
news:l31ll0hkfvrn$.kwwxuxcg1hpk$.(E-Mail Removed)...
> Am Thu, 13 Oct 2005 09:18:09 -0400 schrieb John Strung:
>
> Your shown code seems to be ok. Did you check that ObjCtl2 really points
> to
> the proper CommandBarButton?

Am Fri, 14 Oct 2005 10:10:04 -0400 schrieb John Strung:

John, there´s nothing else: Either ObjCtl2 points to the wrong button or
you´re calling the letterhead section twice.

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook

> Yes. I ran a watch and stepped through the code. It always points to "Full
> Signature", even when it inserts "Letterhead". The odd thing is that it
> works every second time. It is not random.
>
> "Michael Bauer" <(E-Mail Removed)> wrote in message
> news:l31ll0hkfvrn$.kwwxuxcg1hpk$.(E-Mail Removed)...
>> Am Thu, 13 Oct 2005 09:18:09 -0400 schrieb John Strung:
>>
>> Your shown code seems to be ok. Did you check that ObjCtl2 really points
>> to
>> the proper CommandBarButton?

In article <z1s36t7elasb$.(E-Mail Removed)>,
Michael Bauer <(E-Mail Removed)> wrote:

> Am Fri, 14 Oct 2005 10:10:04 -0400 schrieb John Strung:
>
> John, there´s nothing else: Either ObjCtl2 points to the wrong button or
> you´re calling the letterhead section twice.

I am a baffled as you are Michael. The really puzzling thing is that it
works every second time. Given the code, how could ObjCtl2 point to
"letterhead" on one run and to "full signature" on the nmxt?

Am Sat, 15 Oct 2005 18:37:37 -0400 schrieb John Strung:

Your computer is no magician, John :-)

As you aren´t showing the full source it *may be* possible that you´re
calling the the wrong section twice, or the cursor hasn´t the expected
position. But without the full source we can just guess.

Due to the strange structure of your code pieces I guess that there´s one
function for each section. If I´m right, Is that necessary? And additionally
it seems that x is a global variable, maybe also used for other functions?

I suggest that you put together all sections into one function, avoid to
reference the same object twice or three times, declare x within the
function etc.

Another approach could be to build the whole text first and insert it into
the body at once. For getting the signatures text there´re at least two
ways:

1) Use the scripting runtime (e.g.) to read the content of a signature file
(you´ll need a function to get the user´s profile directory).

2) Create a dummy mail,
a) clear all its body,
b) use your CommandBarButton technique to insert a given signature,
c) read the body now,
d) repeat step a) for each sig,
e) destroy the dummy mail.

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook

> In article <z1s36t7elasb$.(E-Mail Removed)>,
> Michael Bauer <(E-Mail Removed)> wrote:
>
>> Am Fri, 14 Oct 2005 10:10:04 -0400 schrieb John Strung:
>>
>> John, there´s nothing else: Either ObjCtl2 points to the wrong button or
>> you´re calling the letterhead section twice.
>
> I am a baffled as you are Michael. The really puzzling thing is that it
> works every second time. Given the code, how could ObjCtl2 point to
> "letterhead" on one run and to "full signature" on the nmxt?

Michael, here is the full code:

----------------------------------

Private Sub email_button_Click()
Dim varx As String, lawinits As String
Dim usnm As String, criteria As String, MyDB As Database
Dim MySet As DAO.Recordset, emaccess As String, nomatch As Variant
Dim x As Long
On Error GoTo emailerrorhandler

Dim olApp As Object
Dim objNewMail As Object
Dim objONewmail As Object
Dim AddressString As String, SubjectString As String
Dim bodystring1 As String, bodystring2 As String, bodystring3 As String
Set olApp = New Outlook.Application
Set objONewmail = olApp.CreateItem(olMailItem)
Set objNewMail = CreateObject("REDEMPTION.SafeMailItem") 'Circumvents
Outlook Security Patch
objNewMail.Item = objONewmail
With objNewMail
AddressString = CStr(Me![email])
SubjectString = CStr([File Name])
bodystring1 = "Our File Number: " & CStr([File Number]) & Chr(10)
bodystring2 = ""
bodystring3 = ""
If IsNull(Me![Claimno]) = 0 Then bodystring2 = "Your Claim Number: " &
CStr(Me![Claimno]) & Chr(10)
If IsNull(Me![DateLoss]) = 0 Then bodystring3 = "Date of Loss: " &
CStr(Me![DateLoss]) & Chr(10)

bodystring1 = bodystring1 & bodystring2 & bodystring3 &
"-------------------------" & Chr(10) & Chr(10) & Chr(10)
..Recipients.Add AddressString
..Recipients.ResolveAll 'TEST THIS LINE
..Subject = SubjectString
..Body = bodystring1
..Display


'The next section inserts the default signature file

'Dim objOutlook As Outlook.Application
Dim ObjCtl As Office.CommandBarControl
Dim ObjPop As Office.commandBarPopup
Dim ObjCB As Office.CommandBar
Dim ObjItem As Object

'Set objOutlook = CreateObject("Outlook.Application")
'Set ObjCB = objOutlook.ActiveInspector.CommandBars("Menu Bar")")
Set ObjCB = olApp.ActiveInspector.CommandBars("Menu Bar")
Set ObjPop = ObjCB.Controls("Insert")
Set ObjPop = ObjPop.Controls("Signature")
Set ObjCtl = ObjPop.Controls.Item("letterhead")
ObjCtl.Execute
'Set objOutlook = Nothing
Set ObjCtl = Nothing
Set ObjPop = Nothing
Set ObjCB = Nothing
Set ObjItem = Nothing

'Next section moves Cursor to bottom of message before inserting signature

'SendKeys "{tab}", True
'SendKeys "{pgdn}", True
'SendKeys "{pgdn}", True

'set cursor position with the Inspector instead
x = 6
Dim sInspector
Dim plaintexteditor
Set sInspector = CreateObject("Redemption.SafeInspector")
sInspector.Item = Outlook.ActiveInspector
Set plaintexteditor = sInspector.plaintexteditor
plaintexteditor.CaretPosY = x

Dim objOutlook2 As Outlook.Application
Dim ObjCtl2 As Office.CommandBarControl
Dim ObjPop2 As Office.commandBarPopup
Dim ObjCB2 As Office.CommandBar
Dim ObjItem2 As Object

'Set objOutlook2 = CreateObject("Outlook.Application")
'Set ObjCB2 = objOutlook2.ActiveInspector.CommandBars("Menu Bar")
Set ObjCB2 = olApp.ActiveInspector.CommandBars("Menu Bar")
Set ObjPop2 = ObjCB2.Controls("Insert")
Set ObjPop2 = ObjPop2.Controls("Signature")
Set ObjCtl2 = ObjPop2.Controls.Item("Full Signature")

ObjCtl2.Execute

'Set objOutlook2 = Nothing
Set ObjCtl2 = Nothing
Set ObjPop2 = Nothing
Set ObjCB2 = Nothing
Set ObjItem2 = Nothing



'set cursor position with the Inspector
x = 6
If IsNull(Me![Claimno]) = True Then x = x - 1
If IsNull(Me![DateLoss]) = True Then x = x - 1
'Dim sInspector
'Dim plaintexteditor
Set sInspector = CreateObject("Redemption.SafeInspector")
sInspector.Item = Outlook.ActiveInspector
Set plaintexteditor = sInspector.plaintexteditor
plaintexteditor.CaretPosY = x

End With

Set olApp = Nothing

Dim utils
Set utils = CreateObject("Redemption.MAPIUtils")


Exit Sub


Exit Sub

emailerrorhandler:
On Error GoTo 0
MsgBox "Open the In Box in MS Outlook and try again"
Exit Sub
End Sub

----------------------

Michael, originally, I had re-used variables in the two sections, (i.e., I
used ObjCtl in the second section where I now use ObjCtl2, but I switched to
using newly named variables in an attempt to fix this problem.)


"Michael Bauer" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> Am Sat, 15 Oct 2005 18:37:37 -0400 schrieb John Strung:
>
> Your computer is no magician, John :-)

Am Sun, 16 Oct 2005 16:48:54 -0400 schrieb John Strung:

Ok, it seems to be a bug in the CommandBars. For me it also toggles between
two different signatures.

I tested with these few lines:

Set ObjCB = olApp.ActiveInspector.CommandBars("Menu Bar")

Set ObjPop = ObjCB.FindControl(, 30005)
Set ObjPop = ObjPop.CommandBar.FindControl(, 31145)

TEST_AGAIN:
Set ObjCtl = ObjPop.Controls.Item(2)
Debug.Print ObjCtl.Caption
ObjCtl.Execute
Set ObjCtl = Nothing
If MsgBox("test again", vbYesNo) = vbYes Then GoTo TEST_AGAIN


So, please, go the way to read the files yourself. The following sample is
from Thorsten Dörfler, a German VB MVP.

This call returns the directory for the sig files:

dim s$
s=GetSpecialFolder(ssfAPPDATA)
if right(s,1)<>"\" then s=s & "\"
s=s & "Microsoft\Signatures\"


<modSpecialFolder>
'----------------------------------------------------------------------------
' Module :modSpecialFolder2
' DateTime :12.01.2004 08:43
' Author :Thorsten Dörfler
' Bei Verteilung muss darauf geachtet werden, die shfolder.dll mitzugeben.
' Die DLL darf aber nicht registriert werden, weil es keine Com-DLL ist.
'----------------------------------------------------------------------------
Option Explicit

Private Type SHITEMID
cb As Long
abID As Byte
End Type

Private Type ITEMIDLIST
mkid As SHITEMID
End Type

Private Declare Function SHGetFolderPath Lib "shfolder" Alias
"SHGetFolderPathA" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, _
ByVal hToken As Long, ByVal dwFlags As Long, _
ByVal pszPath As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "Shell32" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, _
ByRef ppidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32" _
(ByVal pidList As Long, ByVal lpBuffer As String) As Long

Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" _
(ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" _
(ByVal hLibModule As Long) As Long

Private Const S_OK = 0
Private Const MAX_PATH = 260

Private Const CSIDL_FLAG_CREATE = &H8000&

Public Enum ShellSpecialFolderConstants
ssfDESKTOP = &H0
ssfPROGRAMS = &H2
ssfPERSONAL = &H5
ssfFAVORITES = &H6
ssfSTARTUP = &H7
ssfRECENT = &H8
ssfSENDTO = &H9
ssfSTARTMENU = &HB
ssfMYMUSIC = &HD
ssfDESKTOPDIRECTORY = &H10
ssfNETHOOD = &H13
ssfFONTS = &H14
ssfTEMPLATES = &H15
ssfCOMMONSTARTMENU = &H16
ssfCOMMONPROGRAMS = &H17
ssfCOMMONSTARTUP = &H18
ssfCOMMONDESKTOPDIRECTORY = &H19
ssfAPPDATA = &H1A
ssfPRINTHOOD = &H1B
ssfLOCALAPPDATA = &H1C
ssfALTSTARTUP = &H1D
ssfCOMMONALTSTARTUP = &H1E
ssfCOMMONFAVORITES = &H1F
ssfINTERNET_CACHE = &H20
ssfCOOKIES = &H21
ssfHISTORY = &H22
ssfCOMMONAPPDATA = &H23
ssfWINDOWS = &H24
ssfSYSTEM = &H25
ssfPROGRAMFILES = &H26
ssfMYPICTURES = &H27
ssfPROFILE = &H28
ssfPROGRAMFILESCOMMON = &H2B
ssfCOMMONTEMPLATES = &H2D
ssfCOMMONDOCUMENTS = &H2E
ssfCOMMONADMINTOOLS = &H2F
ssfADMINTOOLS = &H30
ssfCOMMONMUSIC = &H35
ssfCOMMONPICTURES = &H36
ssfCOMMONVIDEO = &H37
ssfRESOURCES = &H38
ssfRESOURCESLOCALIZED = &H39
ssfCDBURNAREA = &H3B
End Enum

Public Function GetSpecialFolder(ByVal Folder As
ShellSpecialFolderConstants, _
Optional ByVal ForceCreate As Boolean) As String
Dim tIIDL As ITEMIDLIST
Dim strPath As String
Dim hMod As Long

If (ForceCreate) Then
Folder = Folder Or CSIDL_FLAG_CREATE
End If

If SHGetSpecialFolderLocation(0, Folder, tIIDL) = S_OK Then
strPath = Space$(MAX_PATH)
If SHGetPathFromIDList(tIIDL.mkid.cb, strPath) <> 0 Then
GetSpecialFolder = left$(strPath, InStr(1, strPath, vbNullChar) - 1)
End If
Else
strPath = Space$(MAX_PATH)
hMod = LoadLibrary("shfolder")
If (hMod <> 0) Then
If SHGetFolderPath(0, Folder, 0, 0, strPath) = S_OK Then
GetSpecialFolder = left$(strPath, InStr(1, strPath, vbNullChar) - 1)
End If
FreeLibrary hMod
End If
End If
End Function
</modSpecialFolder>


--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook

> Private Sub email_button_Click()
> Dim varx As String, lawinits As String
> Dim usnm As String, criteria As String, MyDB As Database
> Dim MySet As DAO.Recordset, emaccess As String, nomatch As Variant
> Dim x As Long
> On Error GoTo emailerrorhandler
>
> Dim olApp As Object
> Dim objNewMail As Object
> Dim objONewmail As Object
> Dim AddressString As String, SubjectString As String
> Dim bodystring1 As String, bodystring2 As String, bodystring3 As String
> Set olApp = New Outlook.Application
> Set objONewmail = olApp.CreateItem(olMailItem)
> Set objNewMail = CreateObject("REDEMPTION.SafeMailItem") 'Circumvents
> Outlook Security Patch
> objNewMail.Item = objONewmail
> With objNewMail
> AddressString = CStr(Me![email])
> SubjectString = CStr([File Name])
> bodystring1 = "Our File Number: " & CStr([File Number]) & Chr(10)
> bodystring2 = ""
> bodystring3 = ""
> If IsNull(Me![Claimno]) = 0 Then bodystring2 = "Your Claim Number: " &
> CStr(Me![Claimno]) & Chr(10)
> If IsNull(Me![DateLoss]) = 0 Then bodystring3 = "Date of Loss: " &
> CStr(Me![DateLoss]) & Chr(10)
>
> bodystring1 = bodystring1 & bodystring2 & bodystring3 &
> "-------------------------" & Chr(10) & Chr(10) & Chr(10)
> .Recipients.Add AddressString
> .Recipients.ResolveAll 'TEST THIS LINE
> .Subject = SubjectString
> .Body = bodystring1
> .Display
>
>
> 'The next section inserts the default signature file
>
> 'Dim objOutlook As Outlook.Application
> Dim ObjCtl As Office.CommandBarControl
> Dim ObjPop As Office.commandBarPopup
> Dim ObjCB As Office.CommandBar
> Dim ObjItem As Object
>
> 'Set objOutlook = CreateObject("Outlook.Application")
> 'Set ObjCB = objOutlook.ActiveInspector.CommandBars("Menu Bar")")
> Set ObjCB = olApp.ActiveInspector.CommandBars("Menu Bar")
> Set ObjPop = ObjCB.Controls("Insert")
> Set ObjPop = ObjPop.Controls("Signature")
> Set ObjCtl = ObjPop.Controls.Item("letterhead")
> ObjCtl.Execute
> 'Set objOutlook = Nothing
> Set ObjCtl = Nothing
> Set ObjPop = Nothing
> Set ObjCB = Nothing
> Set ObjItem = Nothing
>
> 'Next section moves Cursor to bottom of message before inserting signature
>
> 'SendKeys "{tab}", True
> 'SendKeys "{pgdn}", True
> 'SendKeys "{pgdn}", True
>
> 'set cursor position with the Inspector instead
> x = 6
> Dim sInspector
> Dim plaintexteditor
> Set sInspector = CreateObject("Redemption.SafeInspector")
> sInspector.Item = Outlook.ActiveInspector
> Set plaintexteditor = sInspector.plaintexteditor
> plaintexteditor.CaretPosY = x
>
> Dim objOutlook2 As Outlook.Application
> Dim ObjCtl2 As Office.CommandBarControl
> Dim ObjPop2 As Office.commandBarPopup
> Dim ObjCB2 As Office.CommandBar
> Dim ObjItem2 As Object
>
> 'Set objOutlook2 = CreateObject("Outlook.Application")
> 'Set ObjCB2 = objOutlook2.ActiveInspector.CommandBars("Menu Bar")
> Set ObjCB2 = olApp.ActiveInspector.CommandBars("Menu Bar")
> Set ObjPop2 = ObjCB2.Controls("Insert")
> Set ObjPop2 = ObjPop2.Controls("Signature")
> Set ObjCtl2 = ObjPop2.Controls.Item("Full Signature")
>
> ObjCtl2.Execute
>
> 'Set objOutlook2 = Nothing
> Set ObjCtl2 = Nothing
> Set ObjPop2 = Nothing
> Set ObjCB2 = Nothing
> Set ObjItem2 = Nothing
>
>
>
> 'set cursor position with the Inspector
> x = 6
> If IsNull(Me![Claimno]) = True Then x = x - 1
> If IsNull(Me![DateLoss]) = True Then x = x - 1
> 'Dim sInspector
> 'Dim plaintexteditor
> Set sInspector = CreateObject("Redemption.SafeInspector")
> sInspector.Item = Outlook.ActiveInspector
> Set plaintexteditor = sInspector.plaintexteditor
> plaintexteditor.CaretPosY = x
>
> End With
>
> Set olApp = Nothing
>
> Dim utils
> Set utils = CreateObject("Redemption.MAPIUtils")
>
>
> Exit Sub
>
>
> Exit Sub
>
> emailerrorhandler:
> On Error GoTo 0
> MsgBox "Open the In Box in MS Outlook and try again"
> Exit Sub
> End Sub