Visual Basic 5 Developer's Kit

home *** CD-ROM | disk | FTP | other *** search

/ Visual Basic 5 Developer's Kit / vb5 dev kit.iso / dev / postit / postitse.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1995-10-26 | 36.2 KB | 992 lines

VERSION 4.00 Begin VB.Form postit AutoRedraw = -1 'True BorderStyle = 1 'Fixed Single Caption = "'Post-Note - 32 Bit' 1995 Numatic International" ClientHeight = 6936 ClientLeft = 2292 ClientTop = 2832 ClientWidth = 6264 BeginProperty Font name = "MS Sans Serif" charset = 0 weight = 700 size = 7.8 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 7320 Icon = "POSTITSE.frx":0000 Left = 2244 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 6936 ScaleWidth = 6264 Top = 2496 Width = 6360 Begin VB.TextBox DDE Appearance = 0 'Flat Height = 612 Left = 576 TabIndex = 18 Text = "Text1" Top = 8160 Visible = 0 'False Width = 972 End Begin VB.TextBox DDED Appearance = 0 'Flat Height = 612 Left = 288 TabIndex = 17 Text = "Text1" Top = 7296 Visible = 0 'False Width = 972 End Begin VB.TextBox ddedd Appearance = 0 'Flat Height = 612 Left = 1248 TabIndex = 16 Text = "Text1" Top = 8352 Visible = 0 'False Width = 972 End Begin VB.Frame Frame1 Caption = "Info..." Height = 588 Left = 192 TabIndex = 11 Top = 6144 Width = 5772 Begin VB.Label infotab Alignment = 2 'Center Caption = "Enter The Message You Wish To Send" BeginProperty Font name = "Arial" charset = 0 weight = 700 size = 10.2 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 300 Left = 96 TabIndex = 12 Top = 192 Width = 5580 End End Begin VB.TextBox DDEDDD Appearance = 0 'Flat Height = 612 Left = 96 TabIndex = 1 Text = "Text1" Top = 9216 Visible = 0 'False Width = 972 End Begin VB.TextBox DDEDDDD Appearance = 0 'Flat Height = 612 Left = 1152 TabIndex = 2 Text = "Text1" Top = 9216 Visible = 0 'False Width = 972 End Begin TabDlg.SSTab SSTab1 Height = 6924 Left = 0 TabIndex = 3 Tag = "Enter your message you wish to send." Top = 0 Width = 6252 _Version = 65536 _ExtentX = 11028 _ExtentY = 12213 _StockProps = 15 Caption = "Message" BackColor = 12632256 TabsPerRow = 5 Tab = 0 TabOrientation = 0 Tabs = 4 Style = 0 TabMaxWidth = 0 TabHeight = 423 TabCaption(0) = "Message" Tab(0).ControlCount= 1 Tab(0).ControlEnabled= -1 'True Tab(0).Control(0)= "DATUM" TabCaption(1) = "Address" Tab(1).ControlCount= 1 Tab(1).ControlEnabled= 0 'False Tab(1).Control(0)= "out1" TabCaption(2) = "Sound" Tab(2).ControlCount= 1 Tab(2).ControlEnabled= 0 'False Tab(2).Control(0)= "SSTab2" TabCaption(3) = "Send It" Tab(3).ControlCount= 4 Tab(3).ControlEnabled= 0 'False Tab(3).Control(0)= "Frame3" Tab(3).Control(1)= "SendingTo" Tab(3).Control(2)= "SendIt" Tab(3).Control(3)= "Frame2" Begin VB.Frame Frame3 Height = 972 Left = -74520 TabIndex = 26 Top = 672 Width = 5388 Begin Threed.SSCheck REPLYREQ Height = 588 Left = 672 TabIndex = 27 Top = 288 Width = 4080 _Version = 65536 _ExtentX = 7197 _ExtentY = 1037 _StockProps = 78 Caption = "Reply Required ?" BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} name = "Arial" charset = 0 weight = 700 size = 22.2 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty End End Begin VB.Frame SendingTo Caption = "Sending Information..." BeginProperty Font name = "Arial" charset = 0 weight = 700 size = 16.2 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 2700 Left = -74520 TabIndex = 20 Top = 3072 Width = 5388 Begin VB.Label Progress Alignment = 1 'Right Justify BackStyle = 0 'Transparent BorderStyle = 1 'Fixed Single BeginProperty Font name = "Arial" charset = 0 weight = 700 size = 24 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 588 Left = 288 TabIndex = 23 Top = 1920 Width = 4812 End Begin VB.Label SENDUSER Alignment = 1 'Right Justify BackStyle = 0 'Transparent BorderStyle = 1 'Fixed Single BeginProperty Font name = "Arial" charset = 0 weight = 700 size = 24 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 588 Left = 288 TabIndex = 22 Top = 1248 Width = 4812 End Begin VB.Label SENDDEPARTMENT BackStyle = 0 'Transparent BorderStyle = 1 'Fixed Single BeginProperty Font name = "Arial" charset = 0 weight = 700 size = 18 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 588 Left = 288 TabIndex = 21 Top = 576 Width = 4812 End End Begin VB.CommandButton SendIt Caption = "Send" BeginProperty Font name = "Arial" charset = 0 weight = 700 size = 16.2 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 780 Left = -74424 TabIndex = 19 Top = 1920 Width = 5100 End Begin VB.TextBox DATUM BackColor = &H0000FFFF& BeginProperty Font name = "Arial" charset = 0 weight = 700 size = 13.8 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 5388 Left = 288 MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 0 Text = "POSTITSE.frx":030A Top = 576 Width = 5580 End Begin TabDlg.SSTab SSTab2 Height = 5484 Left = -74808 TabIndex = 4 Top = 576 Width = 5772 _Version = 65536 _ExtentX = 10181 _ExtentY = 9673 _StockProps = 15 Caption = "Custom Sounds" BackColor = 12632256 TabsPerRow = 3 Tab = 1 TabOrientation = 0 Tabs = 2 Style = 0 TabMaxWidth = 0 TabHeight = 423 TabCaption(0) = "Standard Sounds" Tab(0).ControlCount= 6 Tab(0).ControlEnabled= 0 'False Tab(0).Control(0)= "Popup(5)" Tab(0).Control(1)= "Popup(4)" Tab(0).Control(2)= "Popup(3)" Tab(0).Control(3)= "Popup(2)" Tab(0).Control(4)= "Popup(1)" Tab(0).Control(5)= "Popup(0)" TabCaption(1) = "Custom Sounds" Tab(1).ControlCount= 2 Tab(1).ControlEnabled= -1 'True Tab(1).Control(0)= "Command3D3" Tab(1).Control(1)= "File1" Begin VB.FileListBox File1 Archive = 0 'False BackColor = &H0000FFFF& Enabled = 0 'False BeginProperty Font name = "Arial" charset = 0 weight = 700 size = 13.8 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 4260 Left = 192 ReadOnly = 0 'False TabIndex = 14 Top = 384 Width = 5388 End Begin Threed.SSCommand Command3D3 Height = 348 Left = 768 TabIndex = 13 Top = 4992 Width = 4212 _Version = 65536 _ExtentX = 7430 _ExtentY = 614 _StockProps = 78 Caption = "Listen To It First" BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} name = "Arial" charset = 0 weight = 700 size = 12 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty End Begin Threed.SSOption Popup Height = 396 Index = 0 Left = -73464 TabIndex = 10 Top = 2688 Width = 2892 _Version = 65536 _ExtentX = 5101 _ExtentY = 699 _StockProps = 78 Caption = "Popup" ForeColor = 255 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} name = "Arial" charset = 0 weight = 700 size = 18 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Value = -1 'True End Begin Threed.SSOption Popup Height = 396 Index = 1 Left = -73464 TabIndex = 9 TabStop = 0 'False Top = 1536 Width = 3492 _Version = 65536 _ExtentX = 6160 _ExtentY = 699 _StockProps = 78 Caption = "Honk-Honk" ForeColor = 255 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} name = "Arial" charset = 0 weight = 700 size = 18 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty End Begin Threed.SSOption Popup Height = 396 Index = 2 Left = -73464 TabIndex = 8 TabStop = 0 'False Top = 3840 Width = 3012 _Version = 65536 _ExtentX = 5313 _ExtentY = 699 _StockProps = 78 Caption = "Ship-Bell" ForeColor = 255 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} name = "Arial" charset = 0 weight = 700 size = 18 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty End Begin Threed.SSOption Popup Height = 396 Index = 3 Left = -73464 TabIndex = 7 TabStop = 0 'False Top = 960 Width = 2436 _Version = 65536 _ExtentX = 4297 _ExtentY = 699 _StockProps = 78 Caption = "Bugle" ForeColor = 255 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} name = "Arial" charset = 0 weight = 700 size = 18 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty End Begin Threed.SSOption Popup Height = 396 Index = 4 Left = -73464 TabIndex = 6 TabStop = 0 'False Top = 3264 Width = 2916 _Version = 65536 _ExtentX = 5144 _ExtentY = 699 _StockProps = 78 Caption = "Sickness" ForeColor = 255 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} name = "Arial" charset = 0 weight = 700 size = 18 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty End Begin Threed.SSOption Popup Height = 396 Index = 5 Left = -73464 TabIndex = 5 TabStop = 0 'False Top = 2112 Width = 2724 _Version = 65536 _ExtentX = 4805 _ExtentY = 699 _StockProps = 78 Caption = "Kitten" ForeColor = 255 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} name = "Arial" charset = 0 weight = 700 size = 18 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty End End Begin VB.Frame Frame2 Caption = "User Instructions.." BeginProperty Font name = "Arial" charset = 0 weight = 700 size = 16.2 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 2700 Left = -74520 TabIndex = 24 Top = 3072 Width = 5388 Begin VB.Label Label1 Alignment = 2 'Center Caption = $"POSTITSE.frx":031D BeginProperty Font name = "Arial" charset = 0 weight = 700 size = 16.2 underline = 0 'False italic = -1 'True strikethrough = 0 'False EndProperty Height = 2124 Left = 192 TabIndex = 25 Top = 480 Width = 5004 End End Begin MSOutl.Outline out1 Height = 5484 Left = -74712 TabIndex = 15 Top = 576 Width = 5580 _Version = 65536 _ExtentX = 9843 _ExtentY = 9673 _StockProps = 77 ForeColor = 0 BackColor = 8454143 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} name = "Arial" charset = 0 weight = 700 size = 10.8 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty MousePointer = 1 Style = 4 PicturePlus = "POSTITSE.frx":03B0 PictureMinus = "POSTITSE.frx":0522 PictureLeaf = "POSTITSE.frx":0694 PictureOpen = "POSTITSE.frx":0806 PictureClosed = "POSTITSE.frx":0978 End End Attribute VB_Name = "postit" Attribute VB_Creatable = False Attribute VB_Exposed = False Private Function checkswear() ' warning.... ' this function contains some horrible words - do not look if easily offended ! ' this functions purpose is to check the entire message for swear words, and returns ' 0 if the message is clean, or not 0 if dirty. D = UCase$(DATUM.Text) + " " For A = 1 To Len(D) C = C + UCase$(Mid$(D, A, 1)) Next A D = " " + C S = 0 If InStr(D, "ASSHOLE") > 0 Then S = 1 If InStr(D, "ASS HOLE") > 0 Then S = 1 If InStr(D, "ARSEHOLE") > 0 Then S = 1 If InStr(D, "ARSE HOLE") > 0 Then S = 1 If InStr(D, "BLOODY") > 0 Then S = 1 If InStr(D, "BASTARD") > 0 Then S = 1 If InStr(D, "PRICK") > 0 Then S = 1 If InStr(D, "PENIS") > 0 Then S = 1 If InStr(D, "SHIT") > 0 Then S = 1 If InStr(D, "FUCK") > 0 Then S = 1 If InStr(D, "BOLLOCKS") > 0 Then S = 1 If InStr(D, " PISS") > 0 Then S = 1 If InStr(D, "WANK ") > 0 Then S = 1 If InStr(D, "WANKER ") > 0 Then S = 1 If InStr(D, "WANKING ") > 0 Then S = 1 If InStr(D, "TODGER ") > 0 Then S = 1 If InStr(D, " ASS ") > 0 Then S = 1 If InStr(D, " ARSE ") > 0 Then S = 1 If InStr(D, "DICKHEAD") > 0 Then S = 1 If InStr(D, " SOD ") > 0 Then S = 1 If InStr(D, "VAGINA") > 0 Then S = 1 If InStr(D, " CLIT ") > 0 Then S = 1 If InStr(D, " CUNT ") > 0 Then S = 1 If UCase$(Environ$("WINNAME")) = UCase$(PN_SUPERVISOR) Then S = 0 checkswear = S End Function Private Sub Command3D3_Click() ' this is the listen to custom sound button Dim R As Integer Const SYNC = 1 ' obtain the proper file name f = PN_SOUNDFILES + file1.filename ' go play that sound R = sndPlaySound(ByVal f, SYNC) End Sub Private Sub Form_Load() ' center the form on the screen Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 Dim Ds As Recordset ' open the database (shared) Set Db = OpenDatabase(PN_DATABASE, False) ' get a list of all users on the system SQL$ = "Select * From [Post It Notes] Order By Department,[User name]" Set Ds = Db.OpenRecordset(SQL$, dbOpenSnapshot) ' clear the address list, and then fill in the records OUT1.Clear ' add the first node OUT1.AddItem PN_NETWORK, 0 C = 1 ' counter Od = "" ' old department name ' loop through all the users, adding to the appropriate indentation level ' on a change of department name, set od to the new department name ' this stops recursion routines being needed ! While Not Ds.EOF ' check if the name being processed is the name we were called with (reply mode) If Ds.Fields("WINDOWS NAME") = GlobCmd Then GlobCmd = Ds.Fields("USER NAME") If Ds.Fields("Department") <> Od Then ' new department ' add department at indent 1 OUT1.AddItem Ds.Fields("Department"), C OUT1.Indent(C) = 1 C = C + 1 ' add user at indent 2 OUT1.AddItem Ds.Fields("User Name"), C OUT1.Indent(C) = 2 C = C + 1 Od = Ds.Fields("Department") Else ' add user at indent 2 OUT1.AddItem Ds.Fields("User Name"), C OUT1.Indent(C) = 2 C = C + 1 End If ' next record Ds.MoveNext Wend Ds.Close ' go and expand all department nodes For A = 0 To OUT1.ListCount - 1 If OUT1.HasSubItems(A) Then OUT1.Expand(A) = True Next A ' clear custom sound variable GlobSound = "" DATUM.Text = "" ' AT THIS POINT, GLOBCMD WILL CONTAIN THE LONG NAME FOR THE USER. If GlobCmd <> "" Then ' since we are in reply mode, we should change 'Send' to 'Reply' sendit.Caption = "Reply" ' i think this code is obsolete, but i've left it in just in case ! ' find the user name For A = 0 To (OUT1.ListCount - 1) If OUT1.List(A) = GlobCmd Then Ind = A Exit For End If Next A ' show it OUT1.ListIndex = A ' NEED TO FIND GROUP ABOVE... For A = OUT1.ListIndex To 0 Step -1 If OUT1.Indent(A) = 1 Then OUT1.Expand(A) = True Exit For End If Next A End If End Sub Private Sub Form_Unload(Cancel As Integer) ' close the database (global) Db.Close End Sub Private Sub out1_Click() ' handle expansion and contraction of the list box If OUT1.HasSubItems(OUT1.ListIndex) Then If OUT1.Expand(OUT1.ListIndex) Then OUT1.Expand(OUT1.ListIndex) = False Else OUT1.Expand(OUT1.ListIndex) = True End If End If End Sub Private Sub SENDIT_Click() ' declare the snapshot variable (this should use recordset, but I haven't had time to alter it !) Dim Ds As Recordset ' if we have an item selected... If OUT1.ListIndex <> -1 Then ' check on the swearing content of the message If checkswear() = 1 Then A = MsgBox("Sorry I will not send that message - please clean up you language.", 16, "No Way!") Exit Sub End If ' display the sending message panel sendingto.Visible = True DoEvents ' IS THIS A SINGLE USER? ' a system always has an indent of 0 ' a group always has an indent of 1 ' a user always has an indent of 2 If OUT1.Indent(OUT1.ListIndex) = 2 Then ' SINGLE USER. ' get the user address SQL$ = "SELECT * FROM [POST IT NOTES] WHERE [USER NAME] = '" + OUT1.List(OUT1.ListIndex) + "'" Set Ds = Db.OpenRecordset(SQL$, dbOpenSnapshot) ToName = Ds.Fields("WINDOWS NAME") Department = Ds.Fields("DEPARTMENT") Ds.Close Progress.Caption = "Initiate" ' go and send the message to the user If SendMulti(ToName, Department) <> "OK" Then ' fail - user not logged on A = MsgBox("The message has been added to the message queue for that user", 64, "For Your Information") Else ' message sent A = MsgBox("Your message has been sent to the requested person.", 64, "For Your information") End If Else ' IS THIS THE GLOBAL LIST ? If OUT1.ListIndex = 0 Then ' YES, GLOBAL... '********************************************************************************** '********************************************************************************** '********************************************************************************** ' This next section deals with the supervisor only group broadcast. ' change the name to whoever is your supervisor ' or change the code to whatever you like ! '********************************************************************************** '********************************************************************************** '********************************************************************************** '********************************************************************************** ' do we have rights to do this ? If UCase$(Environ$("WinName")) <> UCase$(PN_SUPERVISOR) Then A = MsgBox("Sorry, But You Do Not Have Enough Rights To Send A Message To All Personnel.", 64, "For Your Information") Else ' get addresses (entire list) SQL$ = "SELECT * FROM [POST IT NOTES] ORDER BY DEPARTMENT,[USER NAME]" Set Ds = Db.OpenRecordset(SQL$, dbOpenSnapshot) ' loop through addresses, sending to all - note, no checking as to whether messages are actually sent here. While Not Ds.EOF ToName = Ds.Fields("WINDOWS NAME") Department = Ds.Fields("DEPARTMENT") Progress.Caption = "Initiate" DoEvents X = SendMulti(ToName, Department) Ds.MoveNext Wend Ds.Close End If Else ' we are dealing with a group. ' THIS IS A GROUP. ' retrieve addresses for group SQL$ = "SELECT * FROM [POST IT NOTES] WHERE DEPARTMENT = '" + OUT1.List(OUT1.ListIndex) + "' ORDER BY [USER NAME]" Set Ds = Db.OpenRecordset(SQL$, dbOpenSnapshot) ' loop through and send messages to all users in a group While Not Ds.EOF ToName = Ds.Fields("WINDOWS NAME") Department = Ds.Fields("DEPARTMENT") Progress.Caption = "Initiate" DoEvents X = SendMulti(ToName, Department) Ds.MoveNext Wend Ds.Close End If End If ' hide the send panel sendingto.Visible = False DoEvents Else ' oops - didn't select a user in the address list. A = MsgBox("Please Select A Person To Send This Message To !", 64, "Oops!") End If Progress.Caption = "" End Sub Private Function SendMulti(UserNam, Department) SENDDEPARTMENT.Caption = "" SENDUSER.Caption = "" DoEvents ' declare recordset variables Dim NoteDS As Recordset UserNam = Trim$(UserNam) On Error Resume Next ' set a double ampersand string to a single ampersand string X = InStr(Department, "& ") If X <> 0 Then XX = Left$(Department, X) XX = XX + "& " XX = XX + Right$(Department, X + 1) Department = XX End If SENDDEPARTMENT.Caption = Department SENDUSER.Caption = UserNam Progress.Caption = "Connect To Network" DoEvents EE = 0 Err = 0 ' repeat this loop 10 times - the other machine should have responded by then ! - if it hasn't, the machine is probably not logged on. While (EE < 10) DDE.LinkTopic = "\\" + UserNam + "\NDDE$|POSTIT" DDE.LinkItem = "CALLER" DDE.LinkMode = 1 If Err <> 0 Then ' cancel the connection, add 1 to the retry count and try again DDE.LinkMode = 0 EE = EE + 1 Else ' we have a connection (this is quick and dirty code, should use boolean structures here) EE = 99 End If ' reset the vb error code to clear. Err = 0 Wend If EE = 99 Then Progress.Caption = "Start Send" DoEvents DDED.LinkTopic = "\\" + UserNam + "\NDDE$|POSTIT" DDED.LinkItem = "DATUM" DDED.LinkMode = 1 DDEDD.LinkTopic = "\\" + UserNam + "\NDDE$|POSTIT" DDEDD.LinkItem = "SOUNDER" DDEDD.LinkMode = 1 DDEDDD.LinkTopic = "\\" + UserNam + "\NDDE$|POSTIT" DDEDDD.LinkItem = "NAMER" DDEDDD.LinkMode = 1 DDEDDDD.LinkTopic = "\\" + UserNam + "\NDDE$|POSTIT" DDEDDDD.LinkItem = "RECORDID" DDEDDDD.LinkMode = 1 For A = 0 To 6 If POPUP(A).Value = True Then B = A Next A ' select standard sounds Select Case B Case 0: Snd = "POPUP" Case 1: Snd = "HONKHONK" Case 2: Snd = "SHIPBELL" Case 3: Snd = "BUGLE" Case 4: Snd = "PUKE" Case 5: Snd = "KITTEN" Case 6: Snd = GlobSound End Select ' kludge If B < 6 Then Snd = Snd + ".WAV" ' WRITE THE INFORMATION OUT TO A USER. Progress.Caption = "Update Database" DoEvents SQL$ = "SELECT * FROM NOTELOG" Set NoteDS = Db.OpenRecordset(SQL$, dbOpenDynaset) On Error GoTo 0 NoteDS.AddNew NoteDS.Fields("USERNAME") = UserNam NoteDS.Fields("DATE") = Now NoteDS.Fields("FROM") = UCase$(Environ$("USERNAME")) NoteDS.Fields("MESSAGE") = DATUM.Text NoteDS.Fields("SOUND") = PN_SOUNDFILES + Snd NoteDS.Fields("READ") = False If ReplyReq.Value = -1 Then NoteDS.Fields("REPLY_REQUIRED") = -1 NoteDS.Update On Error Resume Next NoteDS.Bookmark = NoteDS.LastModified DoEvents Progress.Caption = "Transfer Message" DoEvents ' transfer the instructions over ndde to the other machine DDEDDDD.Text = Str$(NoteDS.Fields("RECORD_ID")) DDEDDDD.LinkPoke DDEDDDD.LinkMode = 0 ' close the recordset NoteDS.Close DDEDD.Text = PN_SOUNDFILES + Snd DDEDD.LinkPoke DDEDD.LinkMode = 0 DDEDDD.Text = Environ$("WINNAME") DDEDDD.LinkPoke DDEDDD.LinkMode = 0 DDE.Text = "From : " + Environ$("USERNAME") DDE.LinkPoke DDED.Text = DATUM.Text DDED.LinkPoke DDED.LinkMode = 0 DDE.LinkExecute ("OK") DDE.LinkMode = 0 End If ' decide what to return to the calling procedure If EE = 99 Then SendMulti = "OK" Progress.Caption = "Complete - OK" Else SendMulti = "error" Progress.Caption = "Complete - FAIL" End If DoEvents End Function Private Sub SSTab1_Click(PreviousTab As Integer) ' set the info field up Select Case SSTab1.Tab Case 0: infotab.Caption = "Enter The Message You Wish To Send" Case 1: infotab.Caption = "Select The User Or Group Of Users To Send It To" Case 2: infotab.Caption = "Select Either A Standard Or Custom Sound" Case 3: infotab.Caption = "Select Any Message Options" End Select DoEvents End Sub Private Sub SSTab2_Click(PreviousTab As Integer) ' display the custom sounds - uses file list box. If SSTab2.Tab = 1 Then postit.file1.Path = PN_SOUNDFILES postit.file1.Pattern = "*.WAV" postit.file1.Enabled = True DoEvents End If End Sub