PDA

View Full Version : [SOLVED:] Don't know why this function can't retrieve folder path for outlook



immigrated
01-26-2022, 01:43 AM
I have this function that I am trying to debug. This isn't my code, and this is a former employee's code who left the organisation long time ago.

The debugger seems to keep pointing towards the red line. I am not as familiar with VBA outlook as with VBA excel. The point of the code is to get the inbox outlook folder from where to extract all attachments, this function is one part of the sub procedure that is being used in outlook_extraction procedure.


Function GetFolder(ByVal FolderPath As String) As Outlook.Folder
Dim oFolder As Outlook.Folder
Dim FoldersArray As Variant
Dim i As Integer
Dim outlookApp
'Dim olNs As Outlook.Namespace
Dim Fldr As Outlook.MAPIFolder
Dim olMail As Variant
Set outlookApp = CreateObject("Outlook.Application")
Set olNs = outlookApp.GetNamespace("MAPI")
'Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
On Error GoTo GetFolderPath_Error
If Left(FolderPath, 2) = "\\" Then FolderPath = Right(FolderPath, Len(FolderPath) - 2)
'Convert folderpath to array
FoldersArray = Split(FolderPath, "\")
'Set oFolder = outlookApp.Session.Folders.Item(FoldersArray(0))
Set oFolder = olNs.Folders.Item(FoldersArray(0))
If Not oFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Outlook.Folders
Set SubFolders = oFolder.Folders
Set oFolder = SubFolders.Item(FoldersArray(i))
If oFolder Is Nothing Then
Set GetFolderPath = Nothing
End If
Next
End If
'Return the oFolder
Set GetFolderPath = oFolder
Exit Function
GetFolderPath_Error:
Set GetFolderPath = Nothing
Exit Function
End Function


Any suggestions?

gmayor
01-26-2022, 10:27 PM
The following, in conjunction with the code I posted at http://www.vbaexpress.com/forum/showthread.php?69553-Save-attachments-with-subject-name will extract all the attachments from messages in the selected folder. You may not require the addition of the message subject (as posted in that response) to the filenames.

Sub ProcessFolder()
'Graham Mayor - https://www.gmayor.com - Last updated - 26 May 2017
Dim olNs As Outlook.NameSpace
Dim olMailFolder As Outlook.MAPIFolder
Dim olItems As Outlook.Items
Dim olMailItem As Outlook.MailItem
Dim oFrm As New frmProgress
Dim PortionDone As Double
Dim i As Long

On Error GoTo err_Handler
Set olNs = GetNamespace("MAPI")
Set olMailFolder = olNs.PickFolder
Set olItems = olMailFolder.Items
oFrm.Show vbModeless
i = 0
For Each olMailItem In olItems
i = i + 1
PortionDone = i / olItems.Count
oFrm.lblProgress.Width = oFrm.fmeProgress.Width * PortionDone
SaveAttachments olMailItem
DoEvents
Next olMailItem
err_Handler:
Unload oFrm
Set oFrm = Nothing
Set olNs = Nothing
Set olMailFolder = Nothing
Set olItems = Nothing
Set olMailItem = Nothing
lbl_Exit:
Exit Sub
End Sub