One more excel/outlook question

[guitardave78]

OK Guys, last one I hope.
This is the code i am useing (Thanks to IDE) to select a folder in Outlook from Excel

Dim myOlApp, myNameSpace, myFolder As Object
Set myOlApp = CreateObject("Outlook.Application&quot
Set myNameSpace = myOlApp.GetNamespace("MAPI&quot
ActiveSheet.Range("A1&quot.Activate
Set myFolder = myNameSpace.Folders(ActiveCell.Offset(0, 0).Value)
i = 1
'myFolder.display
While ActiveCell.Offset(0, i).Value <> &quot;&quot; 'step the path
Set myFolder = myFolder.Folders(ActiveCell.Offset(0, i).Value)
i = i + 1
Wend
'Set myFolder = Application.ActiveExplorer.CurrentFolder


The first cell in the spreadsheet is the frst part of the Outlook path eg public folders
second cell is second part eg
all public folders
etc.

What I want is to be able to Define the variable myFolder useing some form of browse form (ie when macro is run a form with a browse button and a file list), that can look at the outlook folders (Inbox, Tasks etc)
Is this possible!? This would make it more user freindly for some of my work mates!!

 

[ide]

now, again:

i changed my code:

i inserted on a worksheet 4 object: two push button from &quot;Forms&quot; toolbar, a listbox named ListBox1 and a textbox named TextBox1 from &quot;Control Toolbox&quot;.

The code of the worksheet:
'****************** Start Code *******************
Dim LstValue() As String
'Public LstValue() As String

Sub PushBtn()
'On Error Resume Next
Dim mySt, myCtrl As Object
Dim myOlApp, myNameSpace, myFolder As Object

ReDim LstValue(0) 'reset lstvalue
TextBox1 = &quot;&quot; 'reset textbox

Set mySt = ActiveSheet
Set myCtrl = mySt.ListBox1

Set myOlApp = CreateObject(&quot;Outlook.Application&quot
Set myNameSpace = myOlApp.GetNamespace(&quot;MAPI&quot

myCtrl.Clear
myCtrl.ColumnCount = 2
myCtrl.ColumnWidths = &quot;220;50&quot;

For i = 1 To myNameSpace.Folders.Count
myCtrl.AddItem (myNameSpace.Folders(i).Name)
Next i

End Sub


Private Sub ListBox1_Click()
On Error Resume Next
Dim mySt, myCtrl As Object
Dim myOlApp, myNameSpace, myFolder As Object

Set mySt = ActiveSheet
Set myCtrl = mySt.ListBox1

If myCtrl.Value <> &quot;&quot; Then _
ReDim Preserve LstValue(UBound(LstValue) + 1)
LstValue(UBound(LstValue)) = myCtrl.Value

Set myOlApp = CreateObject(&quot;Outlook.Application&quot
Set myNameSpace = myOlApp.GetNamespace(&quot;MAPI&quot
Set myFolder = myNameSpace.Folders(LstValue(1))
For i = 2 To UBound(LstValue)
If LstValue(i) <> &quot;&quot; Then _
Set myFolder = myFolder.Folders(LstValue(i))
Next i
For i = 1 To UBound(LstValue)
If LstValue(i) <> &quot;&quot; Then _
TextBox1 = TextBox1 & &quot;/&quot; & LstValue(i)
Next i


myCtrl.Clear
myCtrl.ColumnCount = 2
myCtrl.ColumnWidths = &quot;220;50&quot;

For i = 1 To myFolder.Folders.Count
myCtrl.AddItem (myFolder.Folders(i).Name)
Next i


End Sub
Sub GetTaskPropertiesFromOutlook()
On Error Resume Next
Dim myOlApp, myNameSpace, myFolder As Object
Set myOlApp = CreateObject(&quot;Outlook.Application&quot
Set myNameSpace = myOlApp.GetNamespace(&quot;MAPI&quot
Set myFolder = myNameSpace.Folders(LstValue(1))
For i = 2 To UBound(LstValue)
If LstValue(i) <> &quot;&quot; Then _
Set myFolder = myFolder.Folders(LstValue(i))
Next i

ActiveSheet.Range(&quot;a1&quot.Activate

'MsgBox myFolder.Name
ActiveCell.Offset(1, 0) = &quot;Subject&quot;
ActiveCell.Offset(1, 1) = &quot;DueDate&quot;
ActiveCell.Offset(1, 2) = &quot;DateCompleted&quot;
ActiveCell.Offset(1, 3) = &quot;StartDate&quot;
ActiveCell.Offset(1, 4) = &quot;Status&quot;
ActiveCell.Offset(1, 5) = &quot;PercentComplete&quot;
ActiveCell.Offset(1, 6) = &quot;Complete&quot;

For i = 1 To myFolder.Items.Count 'get the all items one by one
ActiveCell.Offset(i + 1, 0) = myFolder.Items(i).Subject
ActiveCell.Offset(i + 1, 1) = myFolder.Items(i).DueDate
ActiveCell.Offset(i + 1, 2) = myFolder.Items(i).DateCompleted
ActiveCell.Offset(i + 1, 3) = myFolder.Items(i).StartDate
ActiveCell.Offset(i + 1, 4) = myFolder.Items(i).Status
ActiveCell.Offset(i + 1, 5) = myFolder.Items(i).PercentComplete
ActiveCell.Offset(i + 1, 6) = myFolder.Items(i).Complete
Next i
Set myOlApp = Nothing
End Sub
'****************** END Code *******************

The first button labelled &quot;GetTaskPropertiesFromOutlook&quot; calls the GetTaskPropertiesFromOutlook sub, the second button labelled &quot;Reset (go to root)&quot; calls the PushBtn sub. The path is stored in the LstValue() dynamic array.
If you want to hide listbox or other control you can do it.

hope it helps
ide

 

[guitardave78]

you are the best!!!!!