Forum

Read Messages From ...
 
Notifications
Clear all

Read Messages From Folder

2 Posts
2 Users
0 Reactions
340 Views
(@bill-jone)
Posts: 28
Eminent Member
Topic starter
 

I have this code

Option Explicit

Sub ReadMessagesFromFolder()

' Define the folder path containing the .msg files
Dim Folder As String
Folder = "D:ll" ' Change this to the desired folder path

' Reference the Microsoft Outlook Object Library
Dim msg As Outlook.MailItem
Dim nextRow As Long

' Loop through all .msg files in the folder
Dim fso As FileSystemObject
Dim msgFile As File
Set fso = New FileSystemObject

For Each msgFile In fso.GetFolder(Folder).Files
If UCase(Right(msgFile.Name, 4)) = ".MSG" Then
' Open the .msg file and extract the required information
Set msg = GetObject(msgFile.Path)

' Add the extracted information to the worksheet
nextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(nextRow, 1).Value = msg.SenderName
Cells(nextRow, 2).Value = msg.Subject
Cells(nextRow, 3).Value = msg.ReceivedTime
Cells(nextRow, 4).Value = msg.SenderEmailAddress
End If
Next msgFile
End Sub

I face this error

Run-Time error '429':
ActiveX component create object

in this row Set msg = GetObject(msgFile.Path)

I already have Microsoft Outlook 16.0 Object Library, please can you help me to fix this

 
Posted : 04/02/2023 3:08 pm
(@catalinb)
Posts: 1937
Member Admin
 

Hi Bill,
Try to change the msg declaration:
Dim msg as Object instead of MailItem.

Or, use:

Sub GetMsgDetails()
Dim MyOutlook As Outlook.Application
Dim msg As Outlook.MailItem
Dim x As Namespace
Dim Path As String
Dim i As Long

Set MyOutlook = New Outlook.Application
Set x = MyOutlook.GetNamespace("MAPI")

Dim Folder As String
Folder = "D:ll" ' Change this to the desired folder path

' Loop through all .msg files in the folder
Dim fso As FileSystemObject
Dim msgFile As File, nextRow As Long
Set fso = New FileSystemObject

For Each msgFile In fso.GetFolder(Folder).Files
If UCase(Right(msgFile.Name, 4)) = ".MSG" Then
' Open the .msg file and extract the required information
Set msg = x.OpenSharedItem(msgFile.Path)

' Add the extracted information to the worksheet
nextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(nextRow, 1).Value = msg.SenderName
Cells(nextRow, 2).Value = msg.Subject
Cells(nextRow, 3).Value = msg.ReceivedTime
Cells(nextRow, 4).Value = msg.SenderEmailAddress
End If
Next msgFile
End Sub

 
Posted : 06/02/2023 1:57 pm
Share: