Hello All
so i have tried to get this to work on my own. i figured if i was to create
a macro and use that code that i might be able to get something to work. but
the code below doesnt do what i had hoped.
With OutMail
.To = "
.CC = ""
.BCC = ""
.Subject = strFName
.Body = "Here is the time card for the period starting " & SunDT
.Attachments.Add ActiveWorkbook.FullName
' You can add other files also like this
' .Attachments.Add ("C:\test.txt")
.Display
Application.Wait (Now + TimeValue("0:00:03"))
'create a menu item on the menu bar
CommandBars("Menu Bar").Controls.Add Type:=msoControlPopup,
Befo=11
'create a menu choice on that menu item
CommandBars("Custom Popup 9131281").Controls.Add
Type:=msoControlButton, ID:=3708, Befo=1
'use that menu item to cause the email to be sent
Application.SendKeys ("%ms")
' .Send 'or use .Display
End With
i am attempting to create a menu with the "send now" choice on it. that
would allow me to choose the menu and then the item with the send keys. but
the problem is that the code doesnt cause the email window to grow a menu and
menu item. what am i doing wrong? is there something special i should be
doing to get the email window to respond?
any help is appreciated.
"DawnTreader" wrote:
hello
i have a project that i am working on and it is getting a little
complicated, i am so close, but i have no idea how to get around the little
problem i have.
i am currently working on a solution to send an email
from excel through outlook without any user intervention. i am nearly there.
the problem is adding a menu item in the email window from excel.
what i have is a spreadsheet template where the user enters in information
about worked hours and then hits a button to send that information to me. i
am trying to dummy proof this thing and so i have excel remove all the
toolbars and only have a button that they may hit to both email the sheet and
save it to a specific folder with a very specific name.
at this stage the only thing not working without user intervention is the
emailing of the file. i have tried a few different things, but in the end
there is user intervention required in them all. i have read a lot of stuff
from Ron de Bruin but the only way to get away from user intervention that he
has, requires a lot of other things that wont work in the enviroment that the
users i have are in. so...
at this point i have the button working perfect up to the point where the
email is created, addressed and file attached. the problem is that it then
sits there and waits for the user to hit send. the send keys method isnt
working, at least not on my computer, but i have an idea that might work
around the problem, but i have no idea how to make it work.
i am so close. i looked into the customization of menus in the email window.
there is a command that can be placed on the menu called "Send now". if you
place that on the menu and use sendkeys %f(and the key underlined for Send
now, which i changed to E because S is "save") then it sends the email. this
would mean no user intervention would be required if everyone had that on
thier file menu or if they had a custom menu that i could add on the fly.
i need a way to create that menu item on the fly in the email window, then a
way to remove it after it is done. and i need to be able to turn off the
spell check and turn it on again.
this is the code i am currently working on in excel:
Option Explicit
Sub SaveWorkbook()
Dim USRNM As String
Dim SunDT As String
Dim strFName As String
Dim wsh As Object
Dim fs As Object
Dim DocPath As String
Dim DirString As String
Dim OutApp As Object
Dim OutMail As Object
Set wsh = CreateObject("WScript.Shell")
Set fs = CreateObject("Scripting.FileSystemObject")
DocPath = wsh.SpecialFolders.Item("mydocuments")
DirString = DocPath & "\Time Cards"
With ActiveSheet
USRNM = .Range("EmployeeName").Value
SunDT = Format(.Range("SundayDate").Value, "dd-mmm-yy")
If Trim(USRNM) = "" Or Trim(SunDT) = "" Then
MsgBox "Please add Employee Name and Sunday's Date" & vbLf &
"File not saved!"
Else
If Not fs.FolderExists(DirString) Then
fs.CreateFolder DirString
End If
strFName = "TimeCard " & SunDT & " " & USRNM & ".xls"
.Parent.SaveAs DirString & "\" & strFName
End If
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "
.CC = ""
.BCC = ""
.Subject = strFName
.Body = "Here is the time card for the period starting " & SunDT
.Attachments.Add ActiveWorkbook.FullName
' You can add other files also like this
' .Attachments.Add ("C:\test.txt")
.Display
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%FE"
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
' ActiveWorkbook.SendMail ", strFName
' Application.Quit
End With
End Sub
i created a menu item that uses the send now and made the underlined letter
in the name "E". this allowed me to tell the send keys to use the menu to
send the email, but because i customized my own email window it wont work on
anyone elses. additionally i need to be able to turn off the spell check.
there is a whole lot of code that i have borrowed from Ron de Bruin's site
but he doesnt have a method that will work in my situation. i am hoping that
someone can help me get around the outlook and excel limitations and get this
working the way i would like.
is there a method that i can use in excel to add this menu in the email
window? or do i need to cause the excel vba to create outlook vba that
creates the menu turns off the spellcheck and then sends the email and then
erases the menu, turns on the spell check and erases itself?
below is the thread in powerpoint that had menu creation stuff where i
posted this originally, i am wondering if there is similar stuff that i can
use in this situation.
any and all help appreciated. 
"Steve Rindsberg" wrote:
In article , Aehan wrote:
Thank you so much. I did try adding a new variable myself, but I added it
for the "Size Logos" control and of course it didn't work and I got an error
message!!! Some day I'll get my head round this properly, meantime I'm very
grateful to you for pointing out what I should do in a way that I can
understand.
My pleasure. This one in particular is a toughie to wrap the head around until
you've done it a few times.
Rgds
Aehan
"Steve Rindsberg" wrote:
You're almost there. See this version of what you've written:
Sub Menus()
Dim myMainMenuBar As CommandBar
Dim iHelpMenu As Integer
Dim myCustomMenu As CommandBarControl
Dim myTempMenu As CommandBarControl
On Error Resume Next
Application.CommandBars.ActiveMenuBar.Controls("&L ogos").Delete
On Error GoTo 0
Set myMainMenuBar = Application.CommandBars.ActiveMenuBar
iHelpMenu = myMainMenuBar.Controls("Help").Index
' Add a new control to the main menu bar and set a reference to it:
Set myCustomMenu = myMainMenuBar.Controls.Add(Type:=msoControlPopup, _
befo=iHelpMenu)
' Set properties:
myCustomMenu.Caption = "&Logos"
' This may be the problem ... you're using the same variable for both the
' reference to the new control and for the control you're adding the new
control
' to.
'Set myCustomMenu = myCustomMenu.Controls.Add(Type:=msoControlPopup)
' Instead, use a new variable
Set myTempMenu = myCustomMenu.Controls.Add(Type:=msoControlPopup)
myTempMenu.Caption = "&Insert Logos"
' and add buttons to it:
With myTempMenu.Controls.Add(Type:=msoControlButton)
.Caption = "Red on Black"
.OnAction = "TestMacro"
End With
With myTempMenu.Controls.Add(Type:=msoControlButton)
.Caption = "Red on White"
.OnAction = "TestMacro"
End With
Set myTempMenu = myCustomMenu.Controls.Add(Type:=msoControlPopup)
myTempMenu.Caption = "&Size Logos"
With myTempMenu.Controls.Add(Type:=msoControlButton)
.Caption = "40"
.OnAction = "TestMacro"
End With
End Sub
================================================
Make sense? It seems to do what you're after
In article , Aehan wrote:
I need to create menus with sub menus in VBA for a Ppt Addin. I can create
the menus, but the sub menus have me stumped (I'm quite new to all this). I
have the following code, which creates a sub menu, but the second sub menu
attaches itself to the first sub menu rather than to the main menu!! Can
someone help me please?
Thanks
Aehan
Dim myMainMenuBar As CommandBar
Dim iHelpMenu As Integer
Dim myCustomMenu As CommandBarControl
On Error Resume Next
Application.CommandBars.ActiveMenuBar.Controls("&L ogos").Delete
On Error GoTo 0
Set myMainMenuBar = Application.CommandBars.ActiveMenuBar
iHelpMenu = myMainMenuBar.Controls("Help").Index
Set myCustomMenu = myMainMenuBar.Controls.Add(Type:=msoControlPopup, _
befo=iHelpMenu)
myCustomMenu.Caption = "&Logos"
Set myCustomMenu = myCustomMenu.Controls.Add(Type:=msoControlPopup)
myCustomMenu.Caption = "&Insert Logos"
With myCustomMenu.Controls.Add(Type:=msoControlButton)
.Caption = "Red on Black"
.OnAction = "TestMacro"
End With
With myCustomMenu.Controls.Add(Type:=msoControlButton)
.Caption = "Red on White"
.OnAction = "TestMacro"
End With
Set myCustomMenu = myCustomMenu.Controls.Add(Type:=msoControlPopup)
myCustomMenu.Caption = "&Size Logos"
With myCustomMenu.Controls.Add(Type:=msoControlButton)
.Caption = "40"
.OnAction = "TestMacro"
End With
-----------------------------------------
Steve Rindsberg, PPT MVP
PPT FAQ: www.pptfaq.com
PPTools: www.pptools.com
================================================
-----------------------------------------
Steve Rindsberg, PPT MVP
PPT FAQ: www.pptfaq.com
PPTools: www.pptools.com
================================================