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

Excel macro to copy worksheet from the most recent workbook into another workbook and then send email

Hello,

in Folder "A" I receive a new workbook on a daily basis. Here is an example of the last three:

20120907 Fixing Centa FXDP Report.xls
20120910 Fixing Centa FXDP Report.xls
20120911 Fixing Centa FXDP Report.xls

 I would like to copy the worksheet "A" from the latest workbook into another workbook "B" in folder "B". The latest worksheet "A" should always replace the previous one in workbook "B".

Then, I would like to send an email of the latest version of worksheet"A" in workbook "B".

OR:
I suppose one could just send an email of the worksheet "A" of the latest workbook. So omitting the copying to workbook "B" altogether.


Thanks,
CC
0
CC10
Asked:
CC10
  • 6
  • 4
  • 2
1 Solution
 
mark_harris231Commented:
CC - Have you considered whether you actually even need to send the spreadsheet?  Perhaps just an email notifying users that a new spreadsheet is available with a link to its location?  You could easily accomplish this with a Batch Script (to move the latest to an accessible location and possibly rename it) and Task Scheduler (to send the email).  In this way, you eliminate the overhead of updating another worksheet, and the load on the mail server(s) involved.

Note: This solution is only appropriate if your recipients are able to access a centralize file location.
0
 
CC10Author Commented:
Hello Mark,

unfortunately I do not have that setup yet. At some point I will have a link to my website, but not yet. So for the moment I need to send an email.

CC
0
 
CC10Author Commented:
Can I re-ask the question?

1. I have a workbook that opens automatically every morning (OpenWorkbooks.xls)
2.I would like to insert a macro into that workbook that does the following:

Present structure:
In Folder "A" a new workbook is added on a daily basis.
e.g.
20120907 Fixing Centa FXDP Report.xls
20120910 Fixing Centa FXDP Report.xls
20120911 Fixing Centa FXDP Report.xls

In each workbook there is a selection of worksheets, A,B,C etc.....


The macro should select worksheet "A" from the latest workbook (in this case the 20120911 Fixing Centa FXDP Report.xls) and then send an email of that worksheet to another person.

I can then set a timer onto the macro myself.

Thanks,
CC
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!

 
mark_harris231Commented:
CC10 - Sounds like you will definitely need some VB coding to accomplish this.  Unfortunately, that's outside my skill set.  I would recommend that you use the Request Attention button.  EE Moderators will call attention to your question.
0
 
SteveCommented:
Do you want to send the whole sheet or do you want to send a portion?

mailing a range from Excel:
http://support.microsoft.com/?kbid=816644

mailing a sheet from Excel:
http://msdn.microsoft.com/en-us/library/ff458119(v=office.11).aspx#odc_office_UseExcelObjectModeltoSendMail_MailingSingleSheetasAttachment

If you need help shoehorning these into a workbook let us know.
0
 
CC10Author Commented:
I need to send the whole worksheet as an excel worksheet, not a pdf file.

I think i can manage the email sending. What I need is a macro to select the worksheet, It has to choose the latest workbook in the folder , selected by date, and then send the relevant worksheet.

CC
0
 
SteveCommented:
neither of those methods use PDF,
one sends a range as a sort of table in E-mail
the other sends just a sheet out of a workbook as a new workbook attachment.

For the gathering of the file to send is about using File Scripting Objects.

Can knock something together over the weekend to mail sheet as attachment from a file selected as the "max Dated one".
0
 
CC10Author Commented:
thanks
0
 
SteveCommented:
OK, looking at this one in more detail...

Would you like the file name to be driven by the date (use todays date to calculate the filename) then run if the file exists.
Or would you like the macro to check all the files in the folder and always mail the sheet from the latest dated file?
Not a problem doing either, but will change the code and speed of the macro.
0
 
CC10Author Commented:
Hello,

It would be best if the macro searches for the file with the latest date, not today's date.

Thanks,
CC
0
 
SteveCommented:
Here is some code which when run will:

1) Find the latest numbered file in the same folder which the file the macro is run from is in.

2) Mail a single sheet named "A" to "SomeOne@SomeWhere.com"

Public Sub MailLatestSheet()

Dim strPath As String: strPath = ThisWorkbook.Path
Dim objFS As Object, objFolder As Object
Dim objFi As Object, objFolders As Object
Dim objFiles As Object, objF1 As Object
Dim strFileName As String, strFolder As String, arrfolder
Dim FileLen As Integer, wbF As Workbook
Dim lngFileNumb As Long

Application.ScreenUpdating = False

Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(strPath)
Set objFiles = objFolder.Files
    For Each objF1 In objFiles
        If Right(objF1.Name, 3) = "xls" Then
            If IsNumeric(Left(objF1.Name, 8)) Then
                If lngFileNumb < CLng(Left(objF1.Name, 8)) Then
                    lngFileNumb = CLng(Left(objF1.Name, 8))
                    strFileName = objF1.Name
                End If
            End If
        End If
    Next

Set objF1 = Nothing
Set objFiles = Nothing
Set objFolder = Nothing
Set objFS = Nothing

'set variables here for Mailing *File* , *Sheetname* , *Address*
Call Mail_Sheets(strPath & "\" & strFileName, "A", "SomeOne@SomeWhere.com")

Application.ScreenUpdating = True
'MsgBox "Mail Sent", vbCritical, "Macro Complete"
End Sub

Sub Mail_Sheets(txtSourcewb As String, shtName As String, mAddress As String)
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object

    Set Sourcewb = Workbooks.Open(txtSourcewb, , True)
   
' Next, copy the sheet to a new workbook.
' You can also use the following line, instead of using the ActiveSheet object,
' if you know the name of the sheet you want to mail :
    Sourcewb.Sheets(shtName).Copy

    Set Destwb = ActiveWorkbook

    ' Determine the Excel version, and file extension and format.
    With Destwb
        If Val(Application.Version) < 12 Then
            ' For Excel 2000-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            ' For Excel 2007-2010, exit the subroutine if you answer
            ' NO in the security dialog that is displayed when you copy
            ' a sheet from an .xlsm file with macros disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "You answered NO in the security dialog."
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With

    ' You can use the following statements to change all cells in the
    ' worksheet to values.
    '
    '    With Destwb.Sheets(1).UsedRange
    '        .Cells.Copy
    '        .Cells.PasteSpecial xlPasteValues
    '        .Cells(1).Select
    '    End With
    '
    '    Application.CutCopyMode = False
    '
    ' Save the new workbook, mail, and then delete it.
    TempFilePath = Environ$("temp") & "\"
    
    'create new name for attachment
    TempFileName = "Part of " & Sourcewb.Name & " " _
                 & Format(Now, "dd-mmm-yy h-mm-ss")

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

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
       ' Change the mail address and subject in the macro before
       ' running the procedure.
        With OutMail
            .To = mAddress
            .CC = ""
            .BCC = ""
            .Subject = "Here is your tab" & shtName
            .Body = "Hi – your worksheet is attached. Enjoy!"
            .Attachments.Add Destwb.FullName
            ' You can add other files by uncommenting the following statement.
            '.Attachments.Add ("C:\test.txt")
            ' In place of the following statement, you can use ".Display" to
            ' display the mail.
            .Send
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    ' Delete the file after sending.
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

Open in new window


if you require anything else feel free to ask.
(Sorry for the delay, I thought I would get this done over the weekend, but I didn't)
0
 
CC10Author Commented:
Hello,

this is exactly what I needed. Brilliant!

Many thanks,
CC
0

Featured Post

[Webinar] Database Backup and Recovery

Does your company store data on premises, off site, in the cloud, or a combination of these? If you answered “yes”, you need a data backup recovery plan that fits each and every platform. Watch now as as Percona teaches us how to build agile data backup recovery plan.

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