July 17, 2019
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
Power Query
Power Pivot
Xtreme Pivot Tables
Excel for Decision Making
Excel for Finance
Excel Analysis Toolpak
Power BI
Excel
Word
Outlook
Excel Expert
Excel Customer Service
November 8, 2013
Hi Bill,
Try to change the msg declaration:
Dim msg as Object instead of MailItem.
Or, use:
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
1 Guest(s)