Hi experts,
Below is a macro that pulls attachments from an outlook folder and places them into a folder on my desktop. I am now trying to add to or create an additional macro to copy the contents of each file (mostly PDFs) and paste the contents into excel to extract PO numbers. I would then like to re save the initial file with the extracted PO number so that all the files in the folder are now the same 7 digit PO number. I have searched the internet for recommendations but have been unsuccessful. Any help or feedback on this difficult task is greatly appreciated.
Thank you!
Mychal
Public Sub PDF_Attachments()
Dim OlApp As Object
Dim OlMail As Object
Dim OlItems As Object
Dim OlFolder As Object
Dim j As Integer
Dim strFolder As String
On Error Resume Next
Set OlApp = GetObject(, "Outlook.Application")
If Err.Number = 429 Then
Set OlApp = CreateObject("Outlook.Application")
End If
strFolder = ThisWorkbook.Path & "C:\Users\Mychal\Desktop\Invoices"
Set OlFolder = OlApp.getnamespace("MAPI").Folders("Invoices").Folders("inbox")
Set OlItems = OlFolder.Items
For Each OlMail In OlItems
If OlMail.Attachments.Count > 0 Then
For j = 1 To OlMail.Attachments.Count
OlMail.Attachments.Item(j).SaveAsFile strFolder & "" & OlMail.Attachments.Item(j).Filename
Next j
End If
Next
Set OlFolder = Nothing
Set OlItems = Nothing
Set OlMail = Nothing
Set OlApp = Nothing
MsgBox "Done", vbInformation
End Sub
Below is a macro that pulls attachments from an outlook folder and places them into a folder on my desktop. I am now trying to add to or create an additional macro to copy the contents of each file (mostly PDFs) and paste the contents into excel to extract PO numbers. I would then like to re save the initial file with the extracted PO number so that all the files in the folder are now the same 7 digit PO number. I have searched the internet for recommendations but have been unsuccessful. Any help or feedback on this difficult task is greatly appreciated.
Thank you!
Mychal
Public Sub PDF_Attachments()
Dim OlApp As Object
Dim OlMail As Object
Dim OlItems As Object
Dim OlFolder As Object
Dim j As Integer
Dim strFolder As String
On Error Resume Next
Set OlApp = GetObject(, "Outlook.Application")
If Err.Number = 429 Then
Set OlApp = CreateObject("Outlook.Application")
End If
strFolder = ThisWorkbook.Path & "C:\Users\Mychal\Desktop\Invoices"
Set OlFolder = OlApp.getnamespace("MAPI").Folders("Invoices").Folders("inbox")
Set OlItems = OlFolder.Items
For Each OlMail In OlItems
If OlMail.Attachments.Count > 0 Then
For j = 1 To OlMail.Attachments.Count
OlMail.Attachments.Item(j).SaveAsFile strFolder & "" & OlMail.Attachments.Item(j).Filename
Next j
End If
Next
Set OlFolder = Nothing
Set OlItems = Nothing
Set OlMail = Nothing
Set OlApp = Nothing
MsgBox "Done", vbInformation
End Sub