Solved

Export sheets to new files and email

Posted on 2012-04-07
2
405 Views
Last Modified: 2012-06-27
Our accounts team keep an excel 2010 (running on win7) workbook up to date with various information that needs to be shared with managers. We also use outlook/exchange internally

Each manager has his/her own sheet, and it needs to be mailed to them as a separate sheet in it's own workbook. (they currently do this by copy pasting. it takes about 8 hours a week!)

Using Excel's vbs would it be possible to export this info to separate excel workbooks and then email them?

I was thinking that the logic could follow:

Get all sheets, then for sheets that end in @ (e.g. bob.smith@) export the sheet to it's own new excel workbook and then
either:
save that workbook as bob.smith.xslx in a predefined folder
or even better:
generate a new mail message to bob.smith@domain.local. with the sheet as an attachment.


The only problem is I have no idea where to sart with excel vbs and I was hoping that someone on here may have solved this type of problem before, and could lend a hand :-)
0
Comment
Question by:Wibble_
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
2 Comments
 
LVL 42

Accepted Solution

by:
dlmille earned 500 total points
ID: 37820303
App has a Control Panel sheet for you to change the email domain and subject line.  Then click the button and all sheets ending in @ will be processed to the email address sheetName@domain specified in the Control panel.

The app uses SendMail after copying that particular sheet to a temporary file named after the sheetName, then deletes that temporary file.

Here's the code in a public module - Module1:
Option Explicit

Sub sendWorksheetsViaEmail()
Dim wkb As Workbook
Dim wks As Worksheet
Dim strEmailAddr As String

    Application.ScreenUpdating = False
    
    On Error GoTo errHandler
    
    Set wkb = ThisWorkbook
    
    For Each wks In wkb.Worksheets
        If Right(wks.Name, 1) = "@" Then 'send to person
            strEmailAddr = Left(wks.Name, Len(wks.Name) - 1) & "@" & [emailDomain].Value
            Application.StatusBar = "Sending worksheet to: " & strEmailAddr
            wks.Activate
            Call Mail_ActiveSheet(strEmailAddr, [SubjectLine].Value)
        End If
    Next wks
    
    GoTo gracefulExit
    
errHandler:
    MsgBox "Error: " & Err.Number & "-> " & Err.Description, vbCritical, "Aborting!!!"

gracefulExit:
    Application.StatusBar = False
    wkb.Sheets("Control Panel").Activate
    Application.ScreenUpdating = True
End Sub

Open in new window


Here's the code in a public module called SendMailHelper:
Option Explicit
'Adapted from Source: Ron deBruin @ http://www.rondebruin.nl/mail/folder1/mail2.htm
Sub Mail_ActiveSheet(strEmailAddr As String, strSubject As String)
'Working in 97-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 I As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook

    'Copy the sheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2010, we exit the sub when your answer is
            'NO in the security dialog that you only see  when you copy
            'an sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is 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

    '    'Change all cells in the worksheet to values if you want
    '    With Destwb.Sheets(1).UsedRange
    '        .Cells.Copy
    '        .Cells.PasteSpecial xlPasteValues
    '        .Cells(1).Select
    '    End With
    '    Application.CutCopyMode = False

    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    'TempFileName = "Part of " & Sourcewb.Name & " " _
    '             & Format(Now, "dd-mmm-yy h-mm-ss")

    'use sheet name before @ as the workbook name
    TempFileName = Left(strEmailAddr, InStr(strEmailAddr, "@") - 1)
    
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        For I = 1 To 3
            '.SendMail "ron@debruin.nl", _
            '          "This is the Subject line"
                      
            .SendMail strEmailAddr, _
                      strSubject
                      
            If Err.Number = 0 Then Exit For
        Next I
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Open in new window


This was gleaned from Ron deBruin's website at:  http://www.rondebruin.nl/mail/folder1/mail2.htm, with some modifications (see comments) in the  Mail_ActiveSheet() routine, I passed the email address and subject to this routine, then modified the logic around the tempFile name, etc., to work according to your specifications.

See attached.

Dave
sendWorksheets-r1.xlsm
0
 

Author Closing Comment

by:Wibble_
ID: 37821770
Awesome, thank you :-)
0

Featured Post

Independent Software Vendors: 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!

Question has a verified solution.

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

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

734 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