Hallo,
Ich habe einiges hier zusammengebaut.
1. Wie kann ich beim Kopieren der Daten definieren, dass es nur die Spalten 2 bis 12 und 14 bis 15 kopiert?
2. Beim Speichern der Datei wird es in den übergeordneten Ordner gespeichert. Wie speichere ich es im angegebenen Pfad?
Vielen Dank.
Sub searchandcopy()
Dim datasheet As Worksheet
Dim reportsheet As Worksheet
Dim accountnum 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
Set erange = Sheet4.Range("B4:C18")
Set datasheet = Sheet1
Set reportsheet = Sheet2
accountnum = reportsheet.Range("A1").Value
edress = Application.WorksheetFunction.VLookup(accountnum, erange, 2, False)
reportsheet.Range("B1").Value = edress
reportsheet.Range("A4:O1000").ClearContents
datasheet.Select
finalrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 5 To finalrow
If Cells(i, 14) = accountnum Then
Range(Cells(i, 2), Cells(i, 12)).Copy
reportsheet.Select
Range("A200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
Columns("A:O").Select
Selection.Columns.autofit
datasheet.Select
End If
Next i
reportsheet.Select
Set outlookapp = CreateObject("Outlook.Application")
Set outlookmailitem = outlookapp.createitem(0)
Set myAttachments = outlookmailitem.Attachments
path = "S:\Back Office\EOD Broker Trade Files Imagine\EOD REPORT"
Application.DisplayAlerts = False
filename = "_" & accountnum & "_" & Range("E1") & ".pdf"
subj = accountnum
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 = Range("E1")
outlookmailitem.body = ""
myAttachments.Add (attachment)
outlookmailitem.display
'outlookmailitem.send
Application.DisplayAlerts = True
Set outlookapp = Nothing
Set outlookmailitem = Nothing
Range("A1").Select
End Sub
|