Excel VBA Code HELP - email active sheet plus 1 other


  #1  
Old 03-03-15, 07:14 PM
B
Member
Thread Starter
Join Date: Jul 2006
Location: Central MN
Posts: 539
Upvotes: 0
Received 0 Upvotes on 0 Posts
Excel VBA Code HELP - email active sheet plus 1 other

I posted this on another forum just for excel. Within about 2 hours it was buried on page 8. Hoping someone here can help me.

I have a document set up where each month I have to send a sheet via email to someone. I have the below code linked to a button that says "Email".

Prior to that button coming up, there is another that hides all other sheets.

This active sheet changes monthly (I have 12 different sheets)

I have to send one other sheet with that. This one is updated but is the same sheet every month. Is there a slight modification I can make to this code to include sheet72 (the one that does not change)?

Current Email Code:
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


'Copy the ActiveSheet 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-2013
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


' '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 = ActiveSheet.Range("C1").Value


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "VOC Report for the month of"
.Body = ""
.Attachments.Add Destwb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.display 'or use .Display
End With
On Error GoTo 0
.Close savechanges:=False
End With


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


Set OutMail = Nothing
Set OutApp = Nothing


With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
 
  #2  
Old 03-04-15, 10:31 AM
Z
Member
Join Date: Jan 2008
Location: Southeastern Pennsylvania
Posts: 3,375
Received 121 Upvotes on 112 Posts
hi bc-


I don't actually write VBA (but I think I wrote and posted some sample code here one time). But if I understand what you are saying you want to email this months’ sheet along with sheet 72 – each month.
But first if I look at your code I think there is something missing – I don’t see any kind of actual statement to send the email. Shouldn’t there be a “send” somewhere – most likely here (in red)?

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "VOC Report for the month of"
.Body = ""
.Attachments.Add Destwb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.display 'or use .Display
.send
End With
On Error GoTo 0
.Close savechanges:=False
End With
If I understand VBA, you can select multiple sheets and then copy them in one fell swoop, creating a new ActiveWorkBook. You have created a new ActiveWorkBook using the command to copy just a single sheet – you copied the Active sheet.


Why can’t you replace your following code:
‘Copy the ActiveSheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
with something like this where you copy 2 sheets at the same time : the active sheet AND sheet 72. The syntax for the active sheet copy may be wrong but I think something like this would be the right idea:

‘........Copy the ActiveSheet plus sheet 72 to a new workbook
Sheets(ActiveSheet.Name).Select ‘.......whatever the statement is to SELECT the ACTIVE sheet
Sheets("Sheet72").Select ‘.......whatever name is used to identify sheet 72
SelectedSheets.Copy ‘ .......copy current month sheet and sheet72 to new workbook to be emailed
Set Destwb = ActiveWorkbook
 
  #3  
Old 03-04-15, 10:46 AM
B
Member
Thread Starter
Join Date: Jul 2006
Location: Central MN
Posts: 539
Upvotes: 0
Received 0 Upvotes on 0 Posts
The code brings up a new message in outlook so I can add any other comments or anything before I send it.

As for the rest, I will try it. I did not write this myself, rather googled how to email one sheet and found it. The author said anyone can use it, so I copied it, change a few minor things and now I have to try to mod it.
I will try your suggestion.
If anyone else has any ideas I am totally open to trying just about anything.
 
  #4  
Old 03-04-15, 05:03 PM
Z
Member
Join Date: Jan 2008
Location: Southeastern Pennsylvania
Posts: 3,375
Received 121 Upvotes on 112 Posts
bc -

I found some of the code I believe you are using as an example.

Mail more then one sheet

I see what you are saying, it looks the .display can be used in place of .send which will apparently allow operator review/modification before the email is sent. But if you look at the example you can see where multiple sheets are copied to the new workbook. It seems like that is all you have to do: just copy both of your sheets at the same time at the point in the code where you are now copying just one sheet.

It looks like you modified the code to just copy the current active sheet.
 
  #5  
Old 03-05-15, 07:07 AM
B
Member
Thread Starter
Join Date: Jul 2006
Location: Central MN
Posts: 539
Upvotes: 0
Received 0 Upvotes on 0 Posts
The problem I have is when I use this code:

With Sourcewb
Set TheActiveWindow = ActiveWindow
Set TempWindow = .NewWindow
.Sheets(Array("Sheet1", "Sheet3")).Copy
End With

If I replace the "sheet1","sheet3" with the names, it works. BUT I need to replace "Sheet1" with the active sheet as that is always changing. If I just remove "sheet1" and put ActiveSheet in there, I get an error and it does not work.
 

Last edited by bclacquer; 03-05-15 at 07:35 AM.
  #6  
Old 03-05-15, 08:41 AM
Z
Member
Join Date: Jan 2008
Location: Southeastern Pennsylvania
Posts: 3,375
Received 121 Upvotes on 112 Posts
bc -

I think you just need to use " ActiveSheet.Name" as follows:

Set TempWindow = .NewWindow
.Sheets(Array(ActiveSheet.Name, "Sheet3")).Copy
End With
 
  #7  
Old 03-05-15, 10:38 AM
B
Member
Thread Starter
Join Date: Jul 2006
Location: Central MN
Posts: 539
Upvotes: 0
Received 0 Upvotes on 0 Posts
That did it.
Thank you

I have another issue I may post about, perhaps you can help me on that as well
 
  #8  
Old 03-05-15, 04:32 PM
Z
Member
Join Date: Jan 2008
Location: Southeastern Pennsylvania
Posts: 3,375
Received 121 Upvotes on 112 Posts
That's great bc. I'll check out the other thread.
 
 

Thread Tools
Search this Thread
 
Ask a Question
Question Title:
Description:
Your question will be posted in: