大家帮忙把我的程序加个托盘 笨了点，自己加都是报错!!

Question

Dim Db As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim dih As New Class1
Dim Lin
Dim Str As String
Dim Intes As Integer '设置文件
Dim Namel As Double '循环
Dim Msg As String '对话框
Dim FileName As String
Dim FreeNum As Integer
Dim Tim As StringPublic Sub Conn()
  '建立连接
  Str = App.Path
  If Right(Str, 1) <> "\" Then
    Str = Str & "\DataBase"
  Else
    Str = Str & "DataBase"
  End If
  Str = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & Str & "\Lc_Addlist.mdb" & ";Jet OLEDB:Database password="
End Sub
Sub OpenDzb() '打开地址簿数据表
  Db.Open Str
  Set Rs = New ADODB.Recordset
  Rs.CursorLocation = adUseClient
  Rs.Open "SELECT * FROM LcPassWord", Db, adOpenDynamic, adLockOptimistic
  
  If Rs.RecordCount > 0 Then
    Set MSH.Recordset = Rs
    MshZ 'msh样式
  End If
 ' Rs.Close
 Db.Close
End SubSub MshZ() 'msh样式
  On Error Resume Next
    MSH.ColWidth(0) = 0
    MSH.ColWidth(1) = 500
    MSH.ColWidth(2) = 2000
    MSH.ColWidth(3) = 3000
    MSH.ColWidth(4) = 500
    MSH.ColWidth(5) = 500
    MSH.ColWidth(6) = 500
    MSH.ColWidth(7) = 500
    MSH.ColWidth(8) = 500
    MSH.ColWidth(9) = 0
    MSH.ColWidth(10) = 0
    For Namel = 0 To MSH.Cols - 4
      MSH.Row = 0
      MSH.Col = Namel
      MSH.CellAlignment = 1 '1左中2左下3中上4中中5中下6右上7右中8右下
    Next
End Sub
Private Sub AddSetMnu_Click()
  ForEdit.Show
  ForEdit.Caption = "增加记录"
End Sub
Private Sub MSH_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
    If Button = 2 Then
      PopupMenu ListEditMnu
    End If
End Sub
Private Sub DelSetMnu_Click()
     If MSH.Text <> "" And VBA.IsNumeric(MSH.Text) = True Then
        Msg = MsgBox("确定要删除编号为 " & MSH.Text & " 的记录吗？", vbOKCancel + vbQuestion, "询问")
        If Msg = vbOK Then
          Db.Open Str '连接数据库
          Db.Execute "delete from LcPassWord where 编号 like '" + MSH.Text + "'"
'
          Db.Close
          OpenDzb
        End If
        
      Else
        MsgBox "请选择要删除的记录...", vbOKOnly + vbInformation + vbSystemModal, "提示"
      End IfEnd SubPrivate Sub EditSetMnu_Click()
        Db.Open Str        Set Rs = New ADODB.Recordset
        Rs.CursorLocation = adUseClient
        Rs.Open "SELECT * FROM LcPassWord where 编号 like '" + MSH.Text + "' ", Db, adOpenDynamic, adLockOptimistic
        ForEdit.Show
        ForEdit.Caption = "修改 " & Rs.Fields("编号")
          ForEdit.Text1.Text = Rs.Fields("标题")
          ForEdit.Text2.Text = Rs.Fields("内容")
          ForEdit.Combo1.Text = Rs.Fields("年")
          ForEdit.Combo2.Text = Rs.Fields("月")
          ForEdit.Combo3.Text = Rs.Fields("日")
          ForEdit.Combo4.Text = Rs.Fields("时")
          ForEdit.Combo5.Text = Rs.Fields("分")
          Db.Close
End SubPrivate Sub Form_Load()
Conn '连接数据库
  DoEvents
  OpenDzb
  Timer3.Enabled = True
  Timer3.Interval = 40000
End SubPrivate Sub Form_Unload(Cancel As Integer)
  EXT
End Sub
Private Sub HelpMnu_Click()
  ForHelp.Show
End Sub
Sub EXT()
  On Error Resume Next
  Db.Close
  Rs.Close
End Sub
Private Sub Timer4_Timer()If Month(Now) < 10 Then
Y = "0" & Month(Now)
Else
Y = Month(Now)
End If
If Day(Now) < 10 Then
d = "0" & Day(Now)
Else
d = Day(Now)
End If
If Hour(Now) < 10 Then
h = "0" & Hour(Now)
Else
h = Hour(Now)
End If
If Minute(Now) < 10 Then
mi = "0" & Minute(Now)
Else
mi = Minute(Now)
End If
'Text3 = Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now)Text3 = Year(Now) & Y & m & d & h & miEnd SubPrivate Sub Timer3_Timer()
Db.Open Str
        Set Rs = New ADODB.Recordset
        Rs.CursorLocation = adUseClient
        Rs.Open "SELECT * FROM LcPassWord where 日期 like '" + Text3 + "' ", Db, adOpenDynamic, adLockOptimistic
        If Rs.RecordCount > 0 Then
          popup.Show
          popup.Caption = "你所设置的时间已到 "
          popup.Text2.Text = Rs.Fields("标题")
          popup.Text1.Text = Rs.Fields("内容")
          popup.Label3 = "你设置提醒的日期:    " & Rs.Fields("年") & "/" & Rs.Fields("月") & "/" & Rs.Fields("日")
          popup.Label4 = "你设置提醒的时间:    " & Rs.Fields("时") & ":" & Rs.Fields("分")
          Db.Close
          Else
          Db.Close
          End If
End Sub

Answer 1

报错,你就看那里错了.而不是等着别人帮你做.加托盘参考下面的文章:http://www.vbgood.com/vb.good/article-do-view-articleid-3953.html
下面的代码:http://www.vb-helper.com/HowTo/howto_tray_icon_formless.zip如果你还是不会加,我给你个提示,有个OCX控件,如果我没记错应该叫:TrayIcn6.ocx 你试试找找它.

Answer 2

vb6光盘里有自带用户控件和例程，在\COMMON\TOOLS\VB\UNSUPPRT\SYSTRAY里

Answer 3

我这里写了一个托盘图标类,使用非常方便:http://www.m5home.com/blog2/blogview.asp?logID=217&cateID=2