Results 1 to 2 of 2

Command Button that sends email

Threaded View

  1. #1
    Registered User
    Join Date
    04-26-2007
    Posts
    37

    Command Button that sends email

    Good morning-
    I have a macro set up and tied to a command button that will automatically attach the spreadsheet to an email. Is there anyway to automatically have an email address added to the cc field of the email?

    Here is the current macro:
    Sub Mail_Sheets_Array4()
    'Working in 97-2007
        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 sh As Worksheet
     
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
     
        Set Sourcewb = ActiveWorkbook
     
        'Copy the sheets to a new workbook
        Sourcewb.Sheets(Array("Quote")).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
                'We exit the sub when your answer is NO in the security dialog that you only
                'see  when you copy sheets 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 worksheets to values if you want
        '    For Each sh In Destwb.Worksheets
        '        sh.Select
        '        With sh.UsedRange
        '            .Cells.Copy
        '            .Cells.PasteSpecial xlPasteValues
        '            .Cells(1).Select
        '        End With
        '        Application.CutCopyMode = False
        '        Destwb.Worksheets(1).Select
        '    Next sh
     
        'Save the new workbook/Mail it/Delete it
        TempFilePath = Environ$("temp") & "\"
        TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
     
        With Destwb
            .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
            On Error Resume Next
            .SendMail "", _
                      "Financing Quote"
            On Error GoTo 0
            .Close SaveChanges:=False
        End With
     
        Kill TempFilePath & TempFileName & FileExtStr
     
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End Sub
    I actually had help with this macro from a previous post on this forum so am not to familiar with the ins and outs that make it work. TIA!
    Last edited by msbing916; 09-25-2009 at 12:39 PM. Reason: trying to add code tags

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1