Option Explicit ' This is the Eudora application object Public WithEvents app As EuApplication ' Common variables used in main form Dim MyCaption$ Dim bConnected As Boolean Dim CurrentFolder As EuFolder Dim CurrentMessageID As Long ' Test objects for general use when program is ' stopped and in "immediate mode" Dim tf As EuFolder Dim tm As EuMessage ' Asynchronous flags for updating lists Dim bBusy As Boolean Dim bUpdateTree As Boolean Dim bUpdateContents As Boolean Dim bUpdateMessage As Boolean Function ConnectToEudora() As Boolean ' Return value is true if result is connected On Error Resume Next MousePointer = vbHourglass Dim EudoraServerName$ EudoraServerName$ = "Eudora.EuApplication.1" If app Is Nothing Then ' Connect to an already running server if possible Set app = GetObject(, EudoraServerName) If Err.Number <> 0 Then Err.Clear End If End If If app Is Nothing Then ' No server is running; let's try to create one Set app = CreateObject(EudoraServerName) If Err.Number <> 0 Then Err.Clear End If End If MousePointer = vbDefault ConnectToEudora = Not (app Is Nothing) End Function Function GetKey(ByVal ID As Long) As String Dim k$ k$ = "Key" + CStr(ID) GetKey = k$ End Function Private Sub SetConnected(b As Boolean) On Error Resume Next If b = False Then picConnected.BackColor = RGB(0, 0, 0) labConnected = "not connected" bConnected = False Else picConnected.BackColor = RGB(0, 255, 0) labConnected = "connected" bConnected = True End If End Sub Private Sub UpdateTree() On Error Resume Next MousePointer = vbHourglass MailTree.ImageList = ImageList1 MailTree.LineStyle = tvwTreeLines MailTree.Indentation = 10 MailTree.Nodes.Clear Dim nodX As Node Set nodX = MailTree.Nodes.Add(, , GetKey(app.RootFolder.ID), "RootFolder") UpdateTreeRecursive app.RootFolder nodX.Image = 1 MailTree.SelectedItem = 1 MousePointer = vbDefault End Sub Private Sub UpdateContents() ' update table of contents On Error Resume Next MousePointer = vbHourglass Dim Message As EuMessage Dim Index As Long MailTocName.Caption = CurrentFolder.Name MailToc.Clear If CurrentFolder.bCanContainMessages Then ' update mail folder's table of contents Index = 0 For Each Message In CurrentFolder.Messages MailToc.AddItem Message.Subject, Index MailToc.ItemData(Index) = Message.ID Index = Index + 1 Next If MailToc.ListCount = 0 Then MailMessage.Text = "No messages available to view in this folder" Else MailToc.ListIndex = 0 End If Else MailToc.AddItem "This folder cannot contain messages" MailMessage.Text = "No message selected" End If MousePointer = vbDefault End Sub Sub UpdateMessage() Dim Message As EuMessage MousePointer = vbHourglass If (CurrentMessageID <> 0) Then Set Message = CurrentFolder.Messages.ItemByID(CurrentMessageID) If optBody(0) = True Then MailMessage.Text = Message.Body Else If optBody(1) = True Then MailMessage.Text = Message.BodyAsSimpleText Else If optBody(2) = True Then MailMessage.Text = Message.BodyAsHTML End If End If End If End If MousePointer = vbDefault End Sub Private Sub UpdateTreeRecursive(ByVal ParentFolder As EuFolder) On Error Resume Next Dim PicIndex% Dim nodX As Node Dim ChildFolder As EuFolder Dim keyParent$ Dim keyChild$ MousePointer = vbHourglass For Each ChildFolder In ParentFolder.Folders Select Case ChildFolder.Name Case "In" PicIndex = 6 Case "Out" PicIndex = 7 Case "Trash" PicIndex = 9 Case Else If ChildFolder.bCanContainMessages Then PicIndex = 4 Else PicIndex = 2 End If End Select keyParent = GetKey(ParentFolder.ID) keyChild = GetKey(ChildFolder.ID) Set nodX = MailTree.Nodes.Add(keyParent, tvwChild, keyChild, ChildFolder.Name) nodX.Image = PicIndex nodX.EnsureVisible If ChildFolder.Folders.Count > 0 Then UpdateTreeRecursive ChildFolder End If Next MousePointer = vbDefault End Sub Private Sub app_OnCheckMailComplete() StatusBar1.Panels.Item(1).Text = "Check mail complete" End Sub Private Sub app_OnClose() On Error Resume Next SetConnected False Set app = Nothing End Sub Private Sub app_OnEmptyTrashComplete() StatusBar1.Panels.Item(1).Text = "Empty trash complete" End Sub Private Sub app_OnCompactFoldersComplete() StatusBar1.Panels.Item(1).Text = "Compact folders complete" End Sub Private Sub app_OnFolderChange() On Error Resume Next ' Called when folder hierarchy has changed bUpdateTree = True End Sub Private Sub app_OnSendMailComplete() StatusBar1.Panels.Item(1).Text = "Send mail complete" End Sub Private Sub BtnCheckMail_Click() Dim p$ On Error Resume Next p$ = InputBox("Enter password for checking mail", "Password") app.CheckMail p$ End Sub Private Sub BtnCompactMailFolders_Click() app.CompactFolders End Sub Private Sub BtnConnect_Click() On Error Resume Next SetConnected (ConnectToEudora()) If Not (app Is Nothing) Then Set CurrentFolder = app.InBox bUpdateTree = True bUpdateContents = True bUpdateMessage = True End If End Sub Private Sub BtnEmptyTrash_Click() app.EmptyTrash End Sub Private Sub BtnQueueMessage_Click() On Error Resume Next FrmCompose.Show 1 If ComposeOk = True Then app.QueueMessage ComposeTo, ComposeSubject, ComposeCc, ComposeBcc, ComposeAttach, ComposeBody End If End Sub Private Sub BtnStop_Click() Stop End Sub Private Sub BtnSendQueuedMessages_Click() On Error Resume Next app.SendQueuedMessages End Sub Private Sub BtnShutdownEudora_Click() On Error Resume Next If bConnected = False Then Exit Sub app.CloseEudora End Sub Private Sub Form_Load() On Error Resume Next SetConnected False StatusBar1.Panels(1).Width = StatusBar1.Width bBusy = False bUpdateTree = False bUpdateContents = False bUpdateMessage = False End Sub Private Sub Form_Unload(Cancel As Integer) On Error Resume Next SetConnected False Set app = Nothing End Sub Private Sub MailToc_Click() Dim MessageID As Long CurrentMessageID = MailToc.ItemData(MailToc.ListIndex) bUpdateMessage = True End Sub Private Sub MailTree_Click() On Error Resume Next Dim f As EuFolder Dim n As Node Dim ID As Long Set n = MailTree.SelectedItem ID = Val(Right$(n.Key, Len(n.Key) - 3)) Set f = app.FolderByID(ID, 1) Set CurrentFolder = f UpdateContents End Sub Private Sub Timer1_Timer() If (bBusy) Then Exit Sub If (bConnected = False) Then Exit Sub bBusy = True If (bUpdateTree) Then UpdateTree bUpdateTree = False End If If (bUpdateContents) Then UpdateContents bUpdateContents = False End If If (bUpdateMessage) Then UpdateMessage bUpdateMessage = False End If bBusy = False End Sub Private Sub optBody_Click(Index As Integer) bUpdateMessage = True End Sub>>Hi all,