Code runs right every second time!

J

John Strung

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!)
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
 
M

Michael Bauer

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!)
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[/QUOTE]
Click to expand...
 
J

John Strung

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

Michael Bauer

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?
 
J

John Strung

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.
 
M

Michael Bauer

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.
 
J

John Strung

Michael Bauer said:
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.
Click to expand...

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?
 
M

Michael Bauer

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.
 
J

John Strung

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!)
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
 
M

Michael Bauer

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!)
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[/QUOTE]
Click to expand...
 
J

John Strung

Okay. I will try another solution. Nice to know I am not going crazy!
Thanks for all your help, Michael.

Michael Bauer said:
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!)
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[/QUOTE][/QUOTE]
Click to expand...
Click to expand...
 
J

John Strung

Michael, I have decided to take a slightly different tack. I have created a
custom form with the letterhead on it, called "letterhead form" and stored
it in the Organizational Forms Library. That will eliminate the need for two
difference signatures and solve the toggling problem. However, I am not
clear how to modify my script to load the custom form rather than the
default form. Can you assist?

Thanks againa.
 
J

John Strung

On second thought, would that work? Or does it requiere the template to be
on the recipient's computer as well? Maybe I should be trying to use
Stationery?
 
M

Michael Bauer

Am Mon, 17 Oct 2005 14:53:59 -0400 schrieb John Strung:

Custom forms are not my area. Why don´t you read the files directly?
 
J

John Strung

Thanks, Michael. I may do that. I think I am going to have to rethink this
before proceeding.

Thanks for your help.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Sendkeys Timing 17
Problems accessing Outlook from Access 1
Speeding up my code 1
Outlook VBScript caught as Virus by Symantec every time 2
Problem with Code - converting emails to .htm files 8
Exporting Contacts Code 1
Code runs every other time 1

Top