need Outlook Macro to copy range from cell A2 of an email attachment to last row used and paste it to a specific excel file in C drive

[Latha]

Team,

I have the below codes which I copied from google and edited a bit. but not working as per my requirement.

the objective is to :

identify an email in inbox with a specific subject line "Ageing Report" --> copy the ranges in that report from cell A2 to till end of the row which contains data --> paste it in the cell "A6" onwards in the specific local file "C:\Users\dlatha\Desktop\Collate.xlsx" --> and delete all the cells which are not relevant (for example : after copying data copied till row 565 the macro should delete/clear contents from row 566 onwards)

As said I copied the below codes from google and bit confused where to edit and what to edit to suit my requirement.

Kindly help.

Sub GetAttachmentdata()
Dim olitem As Outlook.MailItem
Dim xlApp As Object
Dim xlWB As Object
Dim xlTempWB As Object
Dim xlSheet As Object
Dim xlTempSheet As Object
Dim lngTempLast As Integer
Dim lngLast As Integer
Dim strFname As String
Dim strTempPath As String
Dim bXLStarted As Boolean


Const strPath As String = "C:\Users\dlatha\Desktop\NewExcel.xlsx" 'the path and name of the local workbook
strTempPath = Left(strPath, InStrRev(strPath, "\")) 'The path of the temporary file

On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Set xlApp = CreateObject("Excel.Application")
bXLStarted = True
End If
xlApp.Visible = True

On Error GoTo 0
'Open the workbook to input the data
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("Sheet1") 'The sheet in the local workbook

'Process the message attachment
With olitem.Attachments.Item(1)
If Right(.DisplayName, 4) = "xlsx" Then
lngLast = xlSheet.Range("A" & xlSheet.Rows.Count).End(-4162).Row
strFname = strTempPath & .DisplayName
.SaveAsFile strFname
Set xlTempWB = xlApp.Workbooks.Open(strFname, editable:=True)
Set xlTempSheet = xlTempWB.Sheets("Report 1")
lngTempLast = xlTempSheet.Range("B" & xlTempSheet.Rows.Count).End(-4162).Row
xlSheet.Range("A" & lngLast + 1, "S" & lngLast + lngTempLast - 1).Value = xlTempSheet.Range("A2", "S" & lngTempLast).Value
xlWB.Save
End If

End With
xlWB.Close SaveChanges:=True
xlTempWB.Close SaveChanges:=False
If bXLStarted Then
xlApp.Quit
End If
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
Set xlTempWB = Nothing
Set xlTempSheet = Nothing
Set olitem = Nothing
End Sub

 

[Latha]

Could anyone please help me on this please... please....