Email selected sheets

[DavidH56]

Hello,

I came across some fabulous code by Dave Peterson which allows me to print
out selected sheets based on checkbox selections. Could someone please
assist me to call a separate macro which I have to send the separate sheets
to separate addressees instead of printing the sheets. My sendmail macro
(called Mail_ActiveSheet) currently sends the activesheet having the email
address in cell A1. I think I got this from Ron Debruin's site. Please see
Dave's code below.

Sub SelectSheets()
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As CheckBox
Dim curWkbk As Workbook

Application.ScreenUpdating = False

Set curWkbk = ActiveWorkbook

' Check for protected workbook
' If ActiveWorkbook.ProtectStructure Then
' MsgBox "Workbook is protected.", vbCritical
' Exit Sub
' End If

' Add a temporary dialog sheet
Set CurrentSheet = ActiveSheet
Set PrintDlg = Workbooks.Add.DialogSheets.Add

SheetCount = 0

' Add the checkboxes
TopPos = 40
For i = 1 To curWkbk.Worksheets.Count
Set CurrentSheet = curWkbk.Worksheets(i)
' Skip empty sheets and hidden sheets
If Application.CountA(CurrentSheet.Cells) <> 0 And _
CurrentSheet.Visible Then
SheetCount = SheetCount + 1
PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
PrintDlg.CheckBoxes(SheetCount).Text = _
CurrentSheet.Name
TopPos = TopPos + 13
End If
Next i

' Move the OK and Cancel buttons
PrintDlg.Buttons.Left = 240

' Set dialog height, width, and caption
With PrintDlg.DialogFrame
.Height = Application.Max _
(68, PrintDlg.DialogFrame.Top + TopPos - 34)
.Width = 230
.Caption = "Select sheets to print"
End With

' Change tab order of OK and Cancel buttons
' so the 1st option button will have the focus
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront

' Display the dialog box
CurrentSheet.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then
If PrintDlg.Show Then
For Each cb In PrintDlg.CheckBoxes
If cb.Value = xlOn Then
Worksheets(cb.Caption).Activate
ActiveSheet.PrintOut
' ActiveSheet.PrintPreview 'for debugging
End If
Next cb
End If
Else
MsgBox "All worksheets are empty."
End If

curWkbk.Close savechanges:=False

' Reactivate original sheet
CurrentSheet.Activate
End Sub


Thank you in advance for your assistance.

 

[ryguy7272]

Send the separate sheets to separate addressees:
http://www.rondebruin.nl/mail/folder2/files.htm

Call the second macro from the first macro:
Sub Macro1()
Msgbox("This is Macro1")
Call Macro2 'This calls for Macro2 to run
End Sub

 

[DavidH56]

Thanks for your quick response ryguy7272,

I tried your suggestion of calling the second macro replacing

If cb.Value = xlOn Then
Worksheets(cb.Caption).Activate
ActiveSheet.PrintOut
' ActiveSheet.PrintPreview 'for debugging
End If

with

If cb.Value = xlOn Then
Worksheets(cb.Caption).Activate
Call Mail_ThisWorkSheet
' ActiveSheet.PrintPreview 'for debugging
End If

but I could not get it to work. I thought if I could just change this
portion of the code from send to the printer to send those sheets that were
selected with the checkboxes to each appropriate address listed in cell A1.

thanks

also I'm using Outlook Express.

Thanks again for your response

 

[Ron de Bruin]

Hi David

If you want send me your test workbook with your test code and I take a look at it for you
You can find my mail address on my site
http://www.rondebruin.nl/

 

[Ron de Bruin]

Hi David

You call a wrong macro

Use this macro if you use OE
http://www.rondebruin.nl/mail/folder1/mail2.htm

I changed a few things for you (body is not possible)

Sub Mail_ActiveSheet()
'Working in 97-2007
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007, we exit the sub when your answer is
'NO in the security dialog that you only see when you copy
'an sheet from a xlsm file with macro's disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is 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 If
End With

' 'Change all cells in the worksheet to values if you want
' With Destwb.Sheets(1).UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
' Application.CutCopyMode = False

'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " _
& Format(Now, "dd-mmm-yy h-mm-ss")

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
.SendMail ActiveSheet.Range("A1").Value, _
"AV Ministry Financial Updates"
On Error GoTo 0
.Close SaveChanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub


And use

Call Mail_ActiveSheet

 

[DavidH56]

Thank you Ron for your time and your expertise. This works to perfectly.