VBA Code for disabling Macro for end user

[TexasBobcat]

Excel Gurus,

Below is my VBA to refresh a file upon opening, emailing out, then closes application.

The problem is when I go to my email and open the file I send, it runs the macro again.

How can I make this VBA more efficient as I do not want my end users to have the macro file?





_________________________________________________________________________
Sub Autpen()
'
' dailyrun Macro
'
Call Refresh

Call emailfiles

Call disablemacros

Call save

End Sub
______________________________________________________________________
Sub disablemacros()


Application.EnableEvents = False
'code to format and save
Application.EnableEvents = True


End Sub
______________________________________________________________________
Sub save()


ActiveWorkbook.Close True




End Sub
________________________________________________________________________
Sub emailfiles()

'Working in 2000-2010
'This example send the last saved version of the Activeworkbook
Dim OutApp As Object
Dim OutMail As Object


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


On Error Resume Next
With OutMail
.To = "Fake Email <fakeemail123@yahoo.com>"
.CC = "Fake Email <fakeemail123@yahoo.com"
.BCC = ""
.Subject = "YTD President's Club Pacing Report"
.Body = "directly from macro"
.Attachments.Add Application.ActiveWorkbook.FullName

.Send
End With
On Error GoTo 0


End Sub
______________________________________________________________________________
Sub Refresh()
'
' Refresh Macro
'


'
ActiveWorkbook.RefreshAll
End Sub

 

[JoeMo]

One way to do what you want is to save the workbook you email with a .xlsx extension and let Excel strip the macro(s) for you. Untested, but I think this modification of your emailfiles module will do that for you.

Sub emailfiles()
'Working in 2000-2010
'This example send the last saved version of the Activeworkbook
Dim OutApp As Object
Dim OutMail As Object
Dim FN As String
FN = Replace(ActiveWorkbook.FullName, ".xlsm", ".xlsx")
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=FN, FileFormat:=51
Application.DisplayAlerts = True
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "Fake Email "
    .CC = "Fake Email .BCC = """
    .Subject = "YTD President's Club Pacing Report"
    .Body = "directly from macro"
    .Attachments.Add FN
    .Send
End With
On Error GoTo 0


End Sub

 

[TexasBobcat]

I used your code, but an error appeared highlighting this line as, "Object variable or with block variable not set,"
FN = Replace(ActiveWorkbook.FullName, ".xlsm", ".xlsx").

Sub Autpen()
'
' dailyrun Macro
'
Call Refresh

Call emailfiles

Call save

End Sub


Sub save()


ActiveWorkbook.Close True




End Sub


Sub emailfiles()

'Working in 2000-2010
'This example send the last saved version of the Activeworkbook
Dim OutApp As Object
Dim OutMail As Object
Dim FN As String
FN = Replace(ActiveWorkbook.FullName, ".xlsm", ".xlsx")
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=FN, FileFormat:=51
Application.DisplayAlerts = True

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


On Error Resume Next
With OutMail
.To = "Ron Callahan <rcallahan@ashleyhc.com>;Andrew Vu <avu@ashleyhc.com>;Ada Lopez <alopez@ashleyhc.com>;Shawn Seals <sseals@ashleyhc.com>;Liz Traugott <ltraugott@ashleyhc.com>;Rebeca Perez <RPerez@ashleyhc.com>;John Malkey <jmalkey@ashleyhc.com>;Mike Gomez <mgomez@ashleyhc.com>;Tami Hernandez <THernandez@ashleyhc.com>;Heather Ward <hward@ashleyhc.com>;Michael Carter <mcarter@ashleyhc.com>;Patti Love <plove@ashleyhc.com>"
.CC = "twilliams@ashleyhc.com"
.BCC = ""
.Subject = "YTD President's Club Pacing Report"
.Body = "directly from macro"
.Attachments.Add FN
.Send

End With
On Error GoTo 0


End Sub
Sub Refresh()
'
' Refresh Macro
'


'
ActiveWorkbook.RefreshAll
End Sub

One way to do what you want is to save the workbook you email with a .xlsx extension and let Excel strip the macro(s) for you. Untested, but I think this modification of your emailfiles module will do that for you.

Sub emailfiles()
'Working in 2000-2010
'This example send the last saved version of the Activeworkbook
Dim OutApp As Object
Dim OutMail As Object
Dim FN As String
FN = Replace(ActiveWorkbook.FullName, ".xlsm", ".xlsx")
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=FN, FileFormat:=51
Application.DisplayAlerts = True
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "Fake Email "
    .CC = "Fake Email .BCC = """
    .Subject = "YTD President's Club Pacing Report"
    .Body = "directly from macro"
    .Attachments.Add FN
    .Send
End With
On Error GoTo 0


End Sub

 

[JoeMo]

Does the activeworkbook have a .xlsm file extension before you execute the errant line?