J
John
Someone helped me a while back and it worked, but for some reason it is not
working now. Before i list my macro, i am trying to have a button that asks
the person what sheet they would like to email, and then it emails that one
worksheet.
It is giving me the error here:
With wb
.SaveAs "Part of " & ThisWorkbook.Name _
& " " & strdate & ".xls"
Here is the entire macro
'Sub Mail_ActiveSheet_Outlook()
msg = msg & vbNewLine
msg = "Before Sending the information, to the data input department,
have you filled out all the required Information?"
msg = msg & vbNewLine & vbNewLine
msg = msg & "Have you filled in all the required CIP fields for ALL
signers on the account? "
msg = msg & vbNewLine
msg = msg & "Have you entered an account Number and Account Type? "
msg = msg & vbNewLine
msg = msg & "If this is a CD, have you filled in the certificate Number,
Interest Plan, etc?"
Title = "NORTH SHORE COMMUNITY BANK AND TRUST COMPANY"
Config = vbOKCancel + vbQuestion
Ans = MsgBox(msg, Config, Title)
If Ans = vbOK Then
If Ans = vbCancel Then Exit Sub
Application.ScreenUpdating = False
Worksheets("Data Input1").Select
Dim OutApp As Object
Dim OutMail As Object
Dim wb As Workbook
Dim strdate As String
strdate = Format(Now, "dd-mm-yy h-mm-ss")
Application.ScreenUpdating = False
ActiveSheet.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs "Part of " & ThisWorkbook.Name _
& " " & strdate & ".xls"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(o)
With OutMail
.To = "email address.com"
.CC = ""
.BCC = ""
.Subject = "TYPE TITLE OF ACCOUNT HERE"
.Body = "TYPE MESSAGE HERE"
.Attachments.Add wb.FullName
.Display
End With
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
Application.ScreenUpdating = True
Set OutMail = Nothing
Set OutApp = Nothing
Worksheets("Print").Select
Else
'Do Something Else
End If
End Sub
working now. Before i list my macro, i am trying to have a button that asks
the person what sheet they would like to email, and then it emails that one
worksheet.
It is giving me the error here:
With wb
.SaveAs "Part of " & ThisWorkbook.Name _
& " " & strdate & ".xls"
Here is the entire macro
'Sub Mail_ActiveSheet_Outlook()
msg = msg & vbNewLine
msg = "Before Sending the information, to the data input department,
have you filled out all the required Information?"
msg = msg & vbNewLine & vbNewLine
msg = msg & "Have you filled in all the required CIP fields for ALL
signers on the account? "
msg = msg & vbNewLine
msg = msg & "Have you entered an account Number and Account Type? "
msg = msg & vbNewLine
msg = msg & "If this is a CD, have you filled in the certificate Number,
Interest Plan, etc?"
Title = "NORTH SHORE COMMUNITY BANK AND TRUST COMPANY"
Config = vbOKCancel + vbQuestion
Ans = MsgBox(msg, Config, Title)
If Ans = vbOK Then
If Ans = vbCancel Then Exit Sub
Application.ScreenUpdating = False
Worksheets("Data Input1").Select
Dim OutApp As Object
Dim OutMail As Object
Dim wb As Workbook
Dim strdate As String
strdate = Format(Now, "dd-mm-yy h-mm-ss")
Application.ScreenUpdating = False
ActiveSheet.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs "Part of " & ThisWorkbook.Name _
& " " & strdate & ".xls"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(o)
With OutMail
.To = "email address.com"
.CC = ""
.BCC = ""
.Subject = "TYPE TITLE OF ACCOUNT HERE"
.Body = "TYPE MESSAGE HERE"
.Attachments.Add wb.FullName
.Display
End With
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
Application.ScreenUpdating = True
Set OutMail = Nothing
Set OutApp = Nothing
Worksheets("Print").Select
Else
'Do Something Else
End If
End Sub