Results 1 to 3 of 3

Help with vba, try to attach single sheet to mail and open before i send it

Threaded View

dodde Help with vba, try to attach... 11-15-2019, 04:39 PM
dodde Re: Help with vba, try to... 11-15-2019, 06:16 PM
saravnepali Re: Help with vba, try to... 11-16-2019, 04:04 PM
  1. #1
    Forum Contributor
    Join Date
    02-27-2015
    Location
    Norge
    MS-Off Ver
    2019
    Posts
    581

    Help with vba, try to attach single sheet to mail and open before i send it

    Hello

    I found this VBA it works , but i whant the vba to open mail so i can write some text before i send it, is there a way doing that
    i also want as in this vba set range of sheet, if there is another vba out there



    Sub Mail_Range()
    'Working in Excel 2000-2016
    'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
        Dim Source As Range
        Dim Dest As Workbook
        Dim wb As Workbook
        Dim TempFilePath As String
        Dim TempFileName As String
        Dim FileExtStr As String
        Dim FileFormatNum As Long
        Dim OutApp As Object
        Dim OutMail As Object
    
        Set Source = Nothing
        On Error Resume Next
        Set Source = Range("A1:K50").SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
    
        If Source Is Nothing Then
            MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
            Exit Sub
        End If
    
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
    
        Set wb = ActiveWorkbook
        Set Dest = Workbooks.Add(xlWBATWorksheet)
    
        Source.Copy
        With Dest.Sheets(1)
            .Cells(1).PasteSpecial Paste:=8
            .Cells(1).PasteSpecial Paste:=xlPasteValues
            .Cells(1).PasteSpecial Paste:=xlPasteFormats
            .Cells(1).Select
            Application.CutCopyMode = False
        End With
    
        TempFilePath = Environ$("temp") & "\"
        TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
    
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2016
            FileExtStr = ".xlsx": FileFormatNum = 51
        End If
    
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
    
        With Dest
            .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
            On Error Resume Next
            With OutMail
                .to = "ron@debruin.nl"
                .CC = ""
                .BCC = ""
                .Subject = "This is the Subject line"
                .Body = "Hi there"
                .Attachments.Add Dest.FullName
                'You can add other files also like this
                '.Attachments.Add ("C:\test.txt")
                .Send   'or use .Display
            End With
            On Error GoTo 0
            .Close savechanges:=False
        End With
    
        Kill TempFilePath & TempFileName & FileExtStr
    
        Set OutMail = Nothing
        Set OutApp = Nothing
    
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End Sub
    
     
    Example 2
    
    The following subroutine sends a newly created workbook with just the visible cells
    in the Selection. The cells will be PasteSpecial as values in the workbook you send.
    
    It is saving the workbook before mailing it with a date/time stamp.
    After the file is sent the workbook will be deleted from your hard disk.
    
    Important: Read also the information below this macro
    
    Sub Mail_Selection()
    'Working in Excel 2000-2016
    'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
        Dim Source As Range
        Dim Dest As Workbook
        Dim wb As Workbook
        Dim TempFilePath As String
        Dim TempFileName As String
        Dim FileExtStr As String
        Dim FileFormatNum As Long
        Dim OutApp As Object
        Dim OutMail As Object
    
        Set Source = Nothing
        On Error Resume Next
        Set Source = Selection.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
    
        If Source Is Nothing Then
            MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
            Exit Sub
        End If
    
        If ActiveWindow.SelectedSheets.Count > 1 Or _
           Selection.Cells.Count = 1 Or _
           Selection.Areas.Count > 1 Then
            MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
                   "You have more than one sheet selected." & vbNewLine & _
                   "You only selected one cell." & vbNewLine & _
                   "You selected more than one area." & vbNewLine & vbNewLine & _
                   "Please correct and try again.", vbOKOnly
            Exit Sub
        End If
    
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
    
        Set wb = ActiveWorkbook
        Set Dest = Workbooks.Add(xlWBATWorksheet)
    
        Source.Copy
        With Dest.Sheets(1)
            .Cells(1).PasteSpecial Paste:=8
            .Cells(1).PasteSpecial Paste:=xlPasteValues
            .Cells(1).PasteSpecial Paste:=xlPasteFormats
            .Cells(1).Select
            Application.CutCopyMode = False
        End With
    
        TempFilePath = Environ$("temp") & "\"
        TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
    
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2016
            FileExtStr = ".xlsx": FileFormatNum = 51
        End If
    
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
    
        With Dest
            .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
            On Error Resume Next
            With OutMail
                .to = "ron@debruin.nl"
                .CC = ""
                .BCC = ""
                .Subject = "This is the Subject line"
                .Body = "Hi there"
                .Attachments.Add Dest.FullName
                'You can add other files also like this
                '.Attachments.Add ("C:\test.txt")
                .Send   'or use .Display
            End With
            On Error GoTo 0
            .Close savechanges:=False
        End With
    
        Kill TempFilePath & TempFileName & FileExtStr
    
        Set OutMail = Nothing
        Set OutApp = Nothing
    
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End Sub
    Last edited by dodde; 11-15-2019 at 06:17 PM.

Thread Information

Users Browsing this Thread

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

Similar Threads

  1. Replies: 0
    Last Post: 05-19-2017, 12:05 PM
  2. [SOLVED] Send file attach in mail shortcut
    By MetteGaga in forum Excel General
    Replies: 3
    Last Post: 02-11-2016, 08:03 AM
  3. Macro to attach range to email in new sheet but not send?
    By Serafin54 in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 10-22-2014, 01:07 PM
  4. Open up a Lotus Notes Database (not mail) create a new post and attach files VBA Excel
    By exceliscool in forum Excel Programming / VBA / Macros
    Replies: 0
    Last Post: 03-12-2014, 03:25 PM
  5. [SOLVED] How to attach file and send mail automatically
    By thuydo in forum Excel Programming / VBA / Macros
    Replies: 4
    Last Post: 06-27-2013, 03:50 AM
  6. [SOLVED] attach file from folder on c:\ to outlook mail and send
    By cfinch100 in forum Excel Programming / VBA / Macros
    Replies: 5
    Last Post: 02-24-2013, 11:33 AM
  7. automatically attach and send by e-mail
    By Simon-ch in forum Excel Programming / VBA / Macros
    Replies: 13
    Last Post: 01-22-2009, 05:31 AM

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