Filtering and e-mailing result
Filtering and e-mailing result
I'm slightly lost with this and have had to resort to forums as I just cannot see what is wrong with the code.
In short I have three tabs,
Tabelle1 List of data, columns A_L.
Sheet 1 A data validation set in A1 which refers to a a list of Line Managers, and a button to activate the code.
Formulae Where I have converted the data from Tabelle1 into usable format.
In Tabelle1 column A there is a list of line managers, I have used the Formulae tab to remove some text after their names, and also create their e-mail addresses as we use a standardized format. So on the Formulae Tab I have the original entry in column F, and their correct e-mail address in column K. (Full range being K2-K98).
In the below code my aim is to filter by column A in Tabelle1, and attache the associated data to an email and send it to the recipient based on the e-mail address from the Formulae tab. However despite haviong defined the erange object, it still says it isn't defined? -
CODE --> VBA
Option Explicit Sub searchandcopy() Dim datasheet As Worksheet Dim Formulae As Worksheet Dim Tabelle1 As Worksheet Dim reportsheet As Worksheet Dim Lineman As String Dim finalrow As Integer Dim i As Integer Dim edress As String Dim subj As String Dim message As String Dim filename As String Dim outlookapp As Object Dim outlookmailitem As Object Dim myAttachments As Object Dim path As String Dim attachment As String Dim erange As Range Set erange = Formulae.Cells("k2:K98") Set datasheet = Tabelle1 Set reportsheet = Sheet1 Lineman = reportsheet.Range("A1").Value edress = Application.WorksheetFunction.VLookup(Lineman, erange, 1, False) reportsheet.Range("B1").Value = edress reportsheet.Range("A2:L1000").ClearContents datasheet.Select finalrow = Cells(Rows.Count, 1).End(xlUp).Row For i = 4 To finalrow If Cells(i, 1) = Lineman Then Range(Cells(i, 3), Cells(i, 9)).Copy reportsheet.Select Range("A200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats datasheet.Select End If Next i reportsheet.Select Set outlookapp = CreateObject("Outlook.Application") Set outlookmailitem = outlookapp.createitem(0) Set myAttachments = outlookmailitem.Attachments path = "C:\Users\extRamsay\Documents\statements\" Application.DisplayAlerts = False filename = Lineman & ".pdf" subj = Lineman ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:= _ path + filename, _ Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ :=False, OpenAfterPublish:=False attachment = path + filename outlookmailitem.To = edress outlookmailitem.cc = "" outlookmailitem.bcc = "" outlookmailitem.Subject = subj outlookmailitem.body = "Please find a copy of your user roles attached" & vbCrLf & "Best Regards" myAttachments.Add (attachment) outlookmailitem.display 'outlookmailitem.send Application.DisplayAlerts = True Set outlookapp = Nothing Set outlookmailitem = Nothing Range("A1").Select End Sub
Any help would be appreciated. Or if someone has a better way of doing this, I'm all for it.
Thanks in advance.
A wise man once said....
"I think, therefore I yam."
SkipVought 25 Oct 18 12:11