0

I'm trying to access sharedfolder through VBA script. Though my code works fine for standard Inbox associated with my company email account, i'm not sure how it works with shared folder (tkMPE SAP). Once I can access and print all headers I would use regex to filter the data or find specific information

Sub ReadEmailHeaderAndSaveToFile()

Dim outlookApp As Outlook.Application
Dim namespace As Outlook.namespace
Dim sharedFolder As Outlook.MAPIFolder
Dim objItem As Object
Dim folderPath As String
Dim textFilePath As String
Dim fso As Object
Dim txtFile As Object

folderPath = "tkMPE SAP" # Here is the problem

textFilePath = "C:\Users\KalakondaNithish\File.txt"

On Error Resume Next ' In case there's an error when accessing the shared folder.

' Create or get a reference to the Outlook Application.
Set outlookApp = New Outlook.Application

If outlookApp Is Nothing Then
    MsgBox "Outlook is not running or properly installed."
    Exit Sub
End If

' Get the MAPI namespace.
Set namespace = outlookApp.GetNamespace("MAPI")

' Access the shared folder by folder path.
Set sharedFolder = namespace.folders(folderPath)

If sharedFolder Is Nothing Then
    MsgBox "Failed to access the shared folder: " & folderPath
    Exit Sub
End If

On Error GoTo 0 ' Reset error handling.

Set fso = CreateObject("Scripting.FileSystemObject")

Set txtFile = fso.CreateTextFile(textFilePath)

For Each objItem In sharedFolder.Items
    If objItem.Class = olMail Then
        txtFile.WriteLine "Subject: " & objItem.Subject
        txtFile.WriteLine "From: " & objItem.SenderName
        txtFile.WriteLine "To: " & objItem.To
        txtFile.WriteLine "CC: " & objItem.CC
        txtFile.WriteLine "Sent: " & objItem.SentOn
        txtFile.WriteLine "Received: " & objItem.ReceivedTime
        txtFile.WriteLine "------------------------" ' Separator between emails.
    End If
Next objItem

' Close and release the text file and file system objects.
txtFile.Close
Set txtFile = Nothing
Set fso = Nothing

' Clean up Outlook objects.
Set objItem = Nothing
Set sharedFolder = Nothing
Set namespace = Nothing
Set outlookApp = Nothing

MsgBox "Email headers have been saved to: " & textFilePath

End Sub

enter image description here

BigBen
  • 46,229
  • 7
  • 24
  • 40
Nithish
  • 53
  • 1
  • 14
  • So what problem are you trying to solve? `Set sharedFolder = namespace.folders(folderPath)` not returning what you need? Or accessing its subfolders? – Dmitry Streblechenko Jul 19 '23 at 15:51

0 Answers0