asked on

Add-in aditional words in Excel File Name

Hi,

I need Experts help to re-write this script to allow add-in information from sheet-2 (Detail Task), cell-C2 for file name creation.

By doing this, the file name will be: "Weekly Summary Report + C2(Sheet-2).

Hope this is possible. I've attached the script that i'm using now for your perusal.

Sub SendEmail()
Dim wb As Workbook
Dim ws As Worksheet
Dim fName As String
Dim SendTo As String
Dim OutlookApp As Object
Dim MItem As Object
Dim subject_ As String
Dim attach_ As String
Dim pWord As String

'Create Outlook
Set OutlookApp = CreateObject("Outlook.Application")

pWord = "rbs"
SendTo = "thevarajan_subramanin@astro.com.my"
fName = "Weekly Summary Report"

Application.DisplayAlerts = False


'Copy to New Sheet '
Sheets(fName).Copy
Set ws = ActiveSheet
With ws
    .Unprotect (pWord)
    With .Range("A1", .Range("A1").End(xlUp))
      .Copy
      .PasteSpecial Paste:=xlPasteFormats
      .PasteSpecial Paste:=xlPasteValues
    End With
    .Range("A30").Formula = "=hyperlink(""\\Poaabc04\regional programming\RBS Prime Data\RBS Productivity & KPI Measurement"",""For more details: Click here"")"
    .Range("A1").Select
End With

'Save Temp Copy'
Set wb = ActiveWorkbook
With wb
  .Sheets("Weekly Summary Report").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="rbs"
  .SaveAs Filename:="C:\" & fName & ".xls"
  .Close
End With

'Fill in Subject Details'
subject_ = fName & ".xls"
attach_ = "C:\" & fName & ".xls"

'Create the Email
Set MItem = OutlookApp.createitem(0)
With MItem
  .To = SendTo
  .Subject = subject_
  .attachments.Add (attach_)
  'Send the Email
  .Send
End With

'Clear Resources
Set MItem = Nothing
Set OutlookApp = Nothing
'Delete File
Kill Pathname:="C:\" & fName & ".xls"
Application.DisplayAlerts = True

End Sub

Open in new window

Chris Bottomley

Hello Theva,

Try changing the line:

fName = "Weekly Summary Report"
to
fName = "Weekly Summary Report" & thisworkbook.sheets("Sheet-2").range("C2")

In the code below I added a space but you can remove it by using the exact line above if required.

Regards,

chris_bottomley

Sub SendEmail()
Dim wb As Workbook
Dim ws As Worksheet
Dim fName As String
Dim SendTo As String
Dim OutlookApp As Object
Dim MItem As Object
Dim subject_ As String
Dim attach_ As String
Dim pWord As String
'Create Outlook
Set OutlookApp = CreateObject("Outlook.Application")
pWord = "rbs"
SendTo = "thevarajan_subramanin@astro.com.my"
fName = "Weekly Summary Report" & " " & thisworkbook.sheets("Sheet-2").range("C2")
Application.DisplayAlerts = False
'Copy to New Sheet '
Sheets(fName).Copy
Set ws = ActiveSheet
With ws
    .Unprotect (pWord)
    With .Range("A1", .Range("A1").End(xlUp))
      .Copy
      .PasteSpecial Paste:=xlPasteFormats
      .PasteSpecial Paste:=xlPasteValues
    End With
    .Range("A30").Formula = "=hyperlink(""\\Poaabc04\regional programming\RBS Prime Data\RBS Productivity & KPI Measurement"",""For more details: Click here"")"
    .Range("A1").Select
End With
'Save Temp Copy'
Set wb = ActiveWorkbook
With wb
  .Sheets("Weekly Summary Report").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="rbs"
  .SaveAs Filename:="C:\" & fName & ".xls"
  .Close
End With
'Fill in Subject Details'
subject_ = fName & ".xls"
attach_ = "C:\" & fName & ".xls"
'Create the Email
Set MItem = OutlookApp.createitem(0)
With MItem
  .To = SendTo
  .Subject = subject_
  .attachments.Add (attach_)
  'Send the Email
  .Send
End With
'Clear Resources
Set MItem = Nothing
Set OutlookApp = Nothing
'Delete File
Kill Pathname:="C:\" & fName & ".xls"
Application.DisplayAlerts = True
End Sub

Open in new window

Theva

ASKER

Hi,

It shows error at this line:

fName = "Weekly Summary Report" & " " & ThisWorkbook.Sheets("Sheet-2").Range("C2")

I've attached the xls file for you to have a better picture. Please refer to "Detail Task" sheet for "C2" information. And code pasted in "E-Mail" command button.
Daily-Productivity-Master-List.xls

Chris Bottomley

Need some clarification then:

You seem to be saying that C2 is on sheet "Detail TAsk" rather then "sheet-2" therefore:

fName = "Weekly Summary Report"
to
fName = "Weekly Summary Report" & thisworkbook.sheets("Detail Task").range("C2")

Chris
Daily-Productivity-Master-List.xls

Theva

ASKER

Hi,

I check the sheet reference in VBA Project (Alt 11), it refers to sheet2 (Detail Task), sorry if pointing the wrong sheet.

However,when I click the e-mail button, it show error at this line:

Sheets(fName).Copy

Chris Bottomley

What are you trying to do .. in the supplied workbook there is no sheet "Weekly Summary Report Theva" ... are you trying to copy the sheet Weekly Summary Report and name it Weekly Summary Report Theva or create a new workbook or what?

Chris

Theva

ASKER

Hi Chris,

When I click the command button "E-Mail" in "detail Task" , this will copy "summary weekly report" and send this file as attachment via email. My objective is, to add the name of the person and make is as "weekly Summary Report @ "user's name", so that the attached file will carry this title.

In this workbook, we can locate the person's name at Detail Task worksheet "Range: C2" or at "Weekly Summary Report" sheet- Range:D1

ASKER CERTIFIED SOLUTION

Chris Bottomley

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Theva

ASKER

Bingo! you're the best Chris:) thanks a lot.