Using the tab name as a workbook name with VBA - vba

Question

I'm completely new to VBA, and I need some help with the following VBA code I found in Microsoft Office (I'm currently using Excel 2007). I want to know how to do three things:
Create a button which runs the code when clicked.
Save a temporary workbook file with the name of the active worksheet, NOT the source workbook's name.
Select all the email addresses in column K and insert them as the recipients of the email created in the code below.
Can someone give me a hand with this?
Sub Mail_ActiveSheet()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
' Determine the Excel version, and file extension and format.
With Destwb
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "You answered NO in the security dialog."
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End With
' You can use the following statements to change all cells in the
' worksheet to values.
' With Destwb.Sheets(1).UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
' Application.CutCopyMode = False
' Save the new workbook, mail, and then delete it.
TempFilePath = Environ$("temp") & "\"
TempFileName = " " & Sourcewb.Name & " " _
& Format(Now, "dd-mmm-yy h-mm-ss")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
' Change the mail address and subject in the macro before
' running the procedure.
With OutMail
.To = "laragon2#its.jnj.com"
.CC = ""
.BCC = ""
.Subject = "test"
.Body = "test"
.Attachments.Add Destwb.FullName
.Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Answer 1

For 1. You can create a button under Developer Tab-->Controls Group --> insert , find a button and assign existing macro to it.
For 2. Change sourcewb.name --> activeSheet.name
For 3. (Assuming Column K, each cell contain one valid email address in each cell)
EDIT You can put the code below after the line :
Set Sourcewb = ActiveWorkbook
Dim recipients As String
Dim i As Long
Dim height as long
With ActiveSheet
.Activate
Height = .Cells(.Rows.Count, 11).End(xlUp).Row ' column k
For i = 1 To Height
If .Cells(i, 11).Value <> "" Then 'if that cell contains ONE email address
recipients = recipients & ";" & .Cells(i, 11).Value 'append it
End If
Next i
If Len(recipients) > 0 Then 'remove the first dummy ";"
recipients = Mid(recipients, 2)
End If
End With
And replace
With OutMail
.To = "laragon2#its.jnj.com"
by
With OutMail
.To = recipients
EDIT 2: To
To change from .cells(i,11) to .cells(i,7) for all the 11
In VBA cells(ROW,COLUMN) syntax is used.
A = 1
B = 2
...
G = 7
K = 11th column and so on
You can also use the code below to replace the original parts
Dim recipients As String
Dim i As Long
Dim height As Long
Dim colNum As Long
With ActiveSheet
.Activate
colNum = .Columns("K").Column ' You can replace K to G <~~~~ Changes here
height = .Cells(.Rows.Count, colNum).End(xlUp).Row '<~~~~ Changes here
For i = 1 To height
If .Cells(i, 11).Value <> "" Then 'if that cell contains ONE email address
recipients = recipients & ";" & .Cells(i, colNum).Value 'append it '<~~~~ Changes here
End If
Next i
If Len(recipients) > 0 Then 'remove the first dummy ";"
recipients = Mid(recipients, 2)
End If
End With