mardi 3 mars 2015

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:


Quote:




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




Excel VBA Code HELP - email active sheet plus 1 other

0 commentaires:

Enregistrer un commentaire

Popular Posts

Categories

Unordered List

Text Widget

Blog Archive

Followers

Fourni par Blogger.