• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 279
  • Last Modified:

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

0
Theva
Asked:
Theva
  • 4
  • 4
1 Solution
 
Chris BottomleySoftware Quality Lead EngineerCommented:
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

0
 
ThevaAuthor Commented:
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
0
 
Chris BottomleySoftware Quality Lead EngineerCommented:
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
0
Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
ThevaAuthor Commented:
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
0
 
Chris BottomleySoftware Quality Lead EngineerCommented:
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
0
 
ThevaAuthor Commented:
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


0
 
Chris BottomleySoftware Quality Lead EngineerCommented:
I have made a few assumptions ... see how this looks:

Chris
Sub SendEmail()
Dim wb As Workbook
Dim ws As Worksheet
Dim strShName As String
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"
strShName = "Weekly Summary Report"
Sheets(strShName).Copy
fName = strShName & "@" & ThisWorkbook.Sheets("Detail Task").Range("C2")
Application.DisplayAlerts = False
'Copy to New Sheet '
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(strShName).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
  .display
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

0
 
ThevaAuthor Commented:
Bingo! you're the best Chris:) thanks a lot.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

  • 4
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now