How can I define a sub or function in VBA?
This is my code:
Private Sub CommandButton1_Click()
Call Send_Mail
End Sub
In Worksheet "Sheet1" I have a CommandButton called Send_Mail and in "Sheet2" I have also a CommandButton. When I click the CommandButton in Sheet2 I want that the Button in Sheet1 will run.
With my code the : error "Sub or Function is not defined" appears.
EDIT:
Code for Send_Mail:
Public Sub Send_Mail_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim nameList As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error GoTo cleanup
For i = 4 To 22
If Range("B4").Value <> "" Then
nameList = nameList & ";" & Range("C" & i).Value
End If
Next
With OutMail
.To = nameList
.Subject = "Subject Line"
.Body = "Body Text"
.Send
End With
cleanup:
Set OutApp = Nothing
MsgBox "E-Mail sent."
MsgBox Err.Description
End Sub
I don't know what the underlying sub procedure attached to the Sheet1 button has been named but it is likely it has a similar name.
'Sheet2's button sub procedure
Private Sub CommandButton1_Click()
Call Sheet1.CommandButton1_Click
End Sub
Related
I have some vba code, which I have attached to a excel button. When pressing the button the outlook mail box will appear- ready to send the mail. But for some reason the workbook is not attached to the mail. In the code below - I think something is wrong with add.attachments. at the end
My VBA code is:
Dim xRg As Range
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("D7"), Target)
If xRg Is Nothing Then Exit Sub
If IsNumeric(Target.Value) And Target.Value > 200 Then
Call Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"
On Error Resume Next
With xOutMail
.To = "Email Address"
.CC = ""
.BCC = ""
.Subject = "send by cell value test"
.Body = xMailBody
.Attachments.Add "W\Desktop\Files\Workbook1
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
The following line of code is not complete:
.Attachments.Add "W\Desktop\Files\Workbook1
The Add method of the Attachments class creates a new attachment in the Attachments collection. The source of the attachment can be a file (represented by the full file system path with a file name), for example:
.Attachments.Add "C:\Test.xslx", olByValue, 1, "Test"
I'd also suggest specifying a local file path.
In my Excel File I have a CommandButton which sends an E-Mail if cells E1, K2 and K5 are filled.
Unfortunately my code does not really work.
Private Sub CommandButton1_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim nameList As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error GoTo cleanup
If Sheets("Sheetname").Range("E1").Value = "" Or _
Sheets("Sheetname").Range("K2").Value = "" Or _
Sheets("Sheetname").Range("K5").Value = "" Then
MsgBox "The Cells E1, K2 and K5 has to be filled!"
Else
MsgBox "All Cells are filled, send E-Mail now"
For i = 2 To 22
If Sheets("efforts and risks").Range("BB2").Value <> "" Then
nameList = nameList & ";" & Sheets("efforts and risks").Range("BB" & i).Value
End If
Next
With OutMail
.To = nameList
.Subject = "subject line"
.Body = "Body Text"
.Send
End With
End If
cleanup:
Set OutApp = Nothing
End Sub
If the cells are filled Excel shows the MsgBox, but it does not send the mail. Which part of my code do I have to change?
Hope someone can help me. Thanks a lot
I have an Excel table and a bit of macro. I wanted to automatically send email to a certain person when cell value == to "Yes". Also I want to send the email only if the date is today.
Please see screenshot:
Error Screenshot Sir
Private Sub cmdMove_Click()
'Sub TestFile()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("J").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*#?*.?*" And _
LCase(Cells(cell.Row, "H").Value) = "Yes" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = ThisWorkbook.ActiveSheet("Server").Range("I3").Value
.Subject = "Reminder"
.Body = "Dear " & Cells(cell.Row, "Ryan").Value _
& vbNewLine & vbNewLine & _
"Please contact us to discuss bringing " & _
"your account up to date"
'You can add files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'Or use Display
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
End Sub
Try something like the following. Assumes Date is in column A and is an actual Date and that can be compared with what the Date function returns. There is a fair bit of tidying up that could be done on this.
I would take note of #BruceWayne's comment regarding using a Worksheet_Change event. If you can decide which cell(s), or column, determine(s) the triggering of the sub e.g. if column H has a value that changes then test each condition and determine whether to send e-mail, then you can call this sub via that event.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 8 Then 'e.g. for column H
TestFile 'name of your sub
End If
End Sub
Note I changed your LCase test as it could never be True with LCase = "Yes" and I used the typed function LCase$.
I have commented out the line for the body as this:
.Cells(cell.Row, "Ryan").Value
will throw an error. The "Ryan" part should be a column reference e.g. "A" or 1.
If the "Ryan" is a named range then you might use something like:
.Cells(cell.Row, .Range("Ryan").Column)
Code:
Option Explicit
Public Sub TestFile()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim wb As Workbook
Set wb = ThisWorkbook
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
With ActiveSheet
For Each cell In .Columns("J").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*#?*.?*" And _
LCase$(.Cells(cell.Row, "H")) = "yes" And .Cells(cell.Row, "A") = Date Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = wb.Worksheets("Server").Range("I3").Value
.Subject = "Reminder"
' .Body = "Dear " & .Cells(cell.Row, "Ryan").Value _
& vbNewLine & vbNewLine & _
"Please contact us to discuss bringing " & _
"your account up to date"
'You can add files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'Or use Display
End With
Set OutMail = Nothing
End If
Next cell
End With
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Example of Worksheet_Event code in Sheet2 code window
And the associated standard module:
I'm trying to create an Outlook Userform, where via a drop down menu an operator can select an email template.
Using this example, this is the code for the Outlook form which works fine.
Private Sub UserForm_Initialize()
With ComboBox1
.AddItem "Test"
.AddItem "Template 2"
.AddItem "Template 3"
.AddItem "Template 7"
.AddItem "Template 5"
.AddItem "Template 6"
End With
End Sub
Private Sub btnOK_Click()
lstNum = ComboBox1.ListIndex
Unload Me
End Sub
This is the code I've started to put together, to select the template. When I use the drop down menu to select the "Test Template" I receive a error here "Test.Select" highlighting an object is required.
Public lstNum As Long
Public Sub ChooseTemplate()
Dim oMail As Outlook.MailItem
Dim oContact As Outlook.ContactItem
Dim strTemplate As String
UserForm1.Show
Select Case lstNum
Case -1
' -1 is what you want to use if nothing is selected
strTemplate = "Test"
Case 0
strTemplate = "template-1"
Case 1
strTemplate = "template-2"
Case 2
strTemplate = "template-3"
Case 3
strTemplate = "template-4"
Case 4
strTemplate = "template-5"
End Select
Test.Select
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Test Facility"
.HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>Hi " You recently confirmed you require continued use of the test facility
"<p>Many thanks and kind regards</p></BODY>" & Signature
.Sensitivity = 2
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
wb.Close savechanges:=True
End If
Set oMail = Nothing
End Sub
To generate mail from a template see https://msdn.microsoft.com/VBA/Outlook-VBA/articles/application-createitemfromtemplate-method-outlook
Set MyItem = Application.CreateItemFromTemplate("C:\statusrep.oft")
Run this code in Outlook to see how to use the selection.
Public lstNum As Long
Public Sub ChooseTemplate()
Dim outMail As Outlook.MailItem
UserForm1.Show
Select Case lstNum
' Following the listbox entries
Case -1
' -1 is what you want to use if nothing is selected
Set OutMail = CreateItemFromTemplate("Path\to\test.oft")
Case 0
Set OutMail = CreateItemFromTemplate("Path\to\test.oft")
Case 1
Set OutMail = CreateItemFromTemplate("Path\to\template-2.oft")
Case 2
Set OutMail = CreateItemFromTemplate("Path\to\template-3.oft")
Case 3
Set OutMail = CreateItemFromTemplate("Path\to\template-7.oft")
Case 4
Set OutMail = CreateItemFromTemplate("Path\to\template-5.oft")
Case 5
Set OutMail = CreateItemFromTemplate("Path\to\template-6.oft")
End Select
' Use for a specific purpose not randomly
' On Error Resume Next
With OutMail
.To = "cell.Value" ' For this Outlook demo
' This should be in the template
' .Subject = "Test Facility"
' .HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>Hi " You recently confirmed you require continued use of the test facility
' "<p>Many thanks and kind regards</p></BODY>" & Signature
' .Sensitivity = 2
.Display
End With
' On Error GoTo 0
cleanup:
Set OutMail = Nothing
End Sub
I have a workbook that has 7 worksheets. I have the below vba to send an email once a value is met on a particular sheet.
Each sheet has a different value and a different attachment to be sent. How do I add a code for each sheet so the email is sent?
Thanks in advance
Set as General (Declarations)
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("M4:M368"), Target) Is Nothing Then
If IsNumeric(Target.Value) And Target.Value < 3500 Then
Call Fuel_LevelW03
End If
End If
End Sub
followed by a module
General Fuel_LevelW03
Sub Fuel_LevelW03()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Hi" & vbNewLine & vbNewLine & _
"Please order fuel as attached." & vbNewLine & _
"" & vbNewLine & _
"Kind Regards" & vbNewLine & _
""
On Error Resume Next
With OutMail
.To = "email address"
.CC = "email address"
.BCC = ""
.Subject = "Fuel Order W03"
.Body = strbody
.Attachments.Add ("H:\Fuel Order Sheets\Glen Eden W03 Pump Station.xlsx")
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
From what I understand, you try to "tell the method" a bit about what the Target.Value was. Just pass the parameter to the function like this :
If IsNumeric(Target.Value) Then
If Target.Value < 3500 Then
Call Fuel_LevelW03( Sh.Name, Target.Value )
End If
End If
and change the function's name with this one :
Fuel_LevelW03( sheetName as String, targetValue as String )
'Change String to appropriate type
EDIT2 : I changed the code around a bit, if you need any help let me know.
EDIT : Ok, here's how you solve this. Inside the "ThisWorkbook" code object (underneath the sheet code objects, on the left side of the code editor), paste this :
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("M4:M368"), Target) Is Nothing Then
If IsNumeric(Target.Value) And Target.Value < 3500 Then
Call Fuel_LevelW03( Sh.Name )
End If
End If
End Sub
Sub Fuel_LevelW03( sheetName as String )
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
If sheetName = "Sheet1" Then 'Replace Sheet1 with the name of your worksheet
strbody = "Hi" & vbNewLine & vbNewLine & _
"Please order fuel as attached." & vbNewLine & _
"" & vbNewLine & _
"Kind Regards" & vbNewLine & _
"STRING BODY1"
With OutMail
.To = "email address"
.CC = "email address"
.BCC = ""
.Subject = "Fuel Order W03"
.Body = strbody
.Attachments.Add ("H:\Fuel Order Sheets\Glen Eden W03 Pump Station.xlsx")
.Send
End With
On Error GoTo 0
ElseIf sheetName = "Sheet2" Then 'Replace Sheet2 with the name of the next sheet and
'Put the same content as the first IF statement, but adapted to "Sheet2"
ElseIf sheetName = "Sheet3" Then 'Replace Sheet3 with the name of the next sheet and
'Put the same content as the first IF statement, but adapted to "Sheet3"
ElseIf sheetName = "Sheet4" Then 'Replace Sheet4 with the name of the next sheet and
'Put the same content as the first IF statement, but adapted to "Sheet4"
'ElseIf ............. (So on, so forth)
End If
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
You can add as many ElseIf's as you want (one for each sheet)
Am pretty sure this is what you need, although am not sure.
If ActiveSheet.Name = "Sheet1" Then
'Do something specific to "Sheet1"
ElseIf ActiveSheet.Name = "Sheet2" Then
'Do something specific to "Sheet2"
'And so on so forth...
End If
You have a button to that macro in each sheet, and depending on the sheet calling the macro, you want a different e-mail to be sent, right? Then this will do it. You can add as many ElseIf's as you want.