Hi,
I have a daily task which requires me to extract data from PDF's attached each daily which are sent via email. I have done some research and found macro's which aim to extract information from outlook into excel. To ensure that i am extracting the correct information i am to use some references such as Email 'Subject" and attachment file names.
Sub CopyAttachmentToExcel(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 = "D:\My Documents\Collate.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("DATA")
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
Can someone please assist which updating this?
Thank you kindly for any assistance.
