Sending activeworksheet by mail

[Contrast90]

Hi
Im having problems with sending the active worksheet by mail. The first part of the code works but the last part doesn't. My main problems are adding the email address and attaching the active worksheet. I have replaced the letters in the email with "x" in order to hide my email. I would really appreciate it with any advice.

Sub Mail()
'
' Mail Makro
'


Dim C As String
C = "Institution"
C = ActiveCell.Text
Dim Count As Integer


    Sheets("data").Select
ActiveSheet.Range("$A$1:$X$43735").AutoFilter Field:=5, Criteria1:=C
ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 1).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
Workbooks.Open Filename:="C:\Users\xxxx\Desktop\Liste"
    Range("A2").Select
    ActiveSheet.Paste
    


Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
    .to = "xxxx@xxx.xx.xx"
    .CC = ""
    .BCC = ""
    .Subject = "!#" & " " & "C"
    .Body = ""
    .Attachments.Add (ActiveWorkbook.Liste.xlsx)
    .Send
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing


End Sub

 

[Rhodie72]

Not sure if this will help, but anyway:

Sub Mail()
' Mail Makro

Dim C As String, Cnt As Integer
Dim OutlookApp As Object, OutlookMail As Object

    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
'    C = "Institution" ' Redundant: next line overwrites it
    C = ActiveCell.Text


    With Sheets("data")
        .Range("$A$1:$X$43735").AutoFilter Field:=5, Criteria1:=C
        .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Select
    End With
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy

    Workbooks.Open Filename:="C:\Users\xxxx\Desktop\Liste"
    Range("A2").Paste

    With OutlookMail
        .to = InputBox("What email addres do you want to send this to?", "Draadloos Pos", "xxxx@xxx.xx.xx")
        .CC = ""
        .BCC = ""
        .Subject = "!#" & " " & "C"
        .Body = ""
        .Attachments.Add ActiveSheet.Name
        .Send
    End With

    Set OutlookMail = Nothing: Set OutlookApp = OutlookMail
End Sub

 

[Contrast90]

Thanks for your reply. I made some modifications based on your respons and now it does send the mail if I delete ".Attachments.Add ActiveSheet.Name". So the only problem I have left is that it doesn't attach the ActiveSheet.

Sub Mail()
'
' Mail Makro
'




Dim C As String
Dim Cnt As Integer
Dim OutlookApp As Object
Dim OutlookMail As Object


    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
    C = ActiveCell.Text


    Sheets("data").Select
ActiveSheet.Range("$A$1:$X$43735").AutoFilter Field:=5, Criteria1:=C
ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 1).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
Workbooks.Open Filename:="C:\Users\xxxx\Desktop\Liste"
    Range("A2").Select
    ActiveSheet.Paste


    With OutlookMail
        .to = InputBox("xxxx@xxx.xx.xx", "Draadloos Pos", "xxxx@xxx.xx.xx")
        .CC = ""
        .BCC = ""
        .Subject = "!#" & " " & "C"
        .Body = ""
        .Attachments.Add ActiveSheet.Name
        .Send
    End With


    Set OutlookMail = Nothing: Set OutlookApp = OutlookMail
End Sub

 

[Rhodie72]

Why not create a copy of the worksheet in its own workbook and then mail that as an attachment?