?
Solved

Add-in aditional words in Excel File Name

Posted on 2010-01-01
8
Medium Priority
?
273 Views
Last Modified: 2012-05-08
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
Comment
Question by:Theva
  • 4
  • 4
8 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26160645
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
 

Author Comment

by:Theva
ID: 26160707
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
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26160754
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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:Theva
ID: 26160890
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
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26160903
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
 

Author Comment

by:Theva
ID: 26160937
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
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 2000 total points
ID: 26160968
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
 

Author Closing Comment

by:Theva
ID: 31671915
Bingo! you're the best Chris:) thanks a lot.
0

Featured Post

New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

840 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question