最近一直在做一个小软件,这个是关于时间管理的。最开始的初衷是因为每天要写日报,然后发邮件给相关人员,整理日报发邮件很费时间所以决定开发一款节省时间的小软件。软件主要功能是实现任务提醒,任务记录,整理好后发送邮件,并能及时在钉钉上发送提醒信息。
我主要的工作是负责前端和主要功能的实现,经过几天的不懈努力现在终于有点小成果了。界面如下图所示:
相关代码如下:
Dim Task As String '单项任务内容
Dim T1, T2, T3, T4, T5 As String '定义单项任务时间
Dim n001, n002, n003, n004, n005 As String '定义单项任务的名称
Dim m As String ' 暂停时间
Dim E As String '开始时间
Dim i As Long 'list1中的任务清单循环变量
Dim c As String '生成的log文件名成
Dim times As Integer '定义开始按钮的次数,用于判断是否写入暂停数据
Dim d As Integer
Dim a9 As Integer '定义随机数更换皮肤
Private Declare Function SkinH_SetAero Lib "SkinH.dll" (ByVal hwnd As Long) As Long
Private Declare Function SkinH_Attach Lib "SkinH.dll" () As Long
Private Declare Function SkinH_AttachEx Lib "SkinH.dll" (ByVal lpSkinFile As String, ByVal lpPasswd As String) As Long
Private Sub Command1_Click()
FrmRemind.Show '打开提醒对话框
End Sub
Private Sub Command2_Click()
'判断列表框是否只有一个项目被选中
If List1.SelCount = 1 Then
List1.RemoveItem List1.ListIndex
ElseIf List1.SelCount = 0 Then
MsgBox "请选择要删除的任务!", vbOKOnly, "提示"
Exit Sub
ElseIf List1.ListCount > 1 Then
'删除列表框中的所选中的多个项目
For i = List1.ListCount - 1 To 0 Step -1
'判断该项目是否被选中,Selected()返回布尔值
If List1.Selected(i) Then
'删除索引号为i的项目
List1.RemoveItem i
End If
Next
End If
End Sub
Private Sub Command4_Click()
'记录按钮按下的次数
times = times + 1
If List1.ListCount = 0 Then
MsgBox "任务列表为空!", vbOKOnly, "提示"
Exit Sub
End If
If Text2.Text = "" Then
MsgBox "请输入任务时间!", vbOKOnly, "提示"
Exit Sub
End If
'开始时间
E = Date & Time
'暂停之后将暂停时间和开始时间写入表格中
If Timer1.Enabled = False And times > 1 Then
Open App.Path & "\c.log" For Append As #1 '同一个文件多次添加文本内容
Randomize
Print #1, "<tr align='center'>" & vbCrLf & _
"<tr align='center'>" & vbCrLf & _
"<td>" & "暂停" & "</td>" & vbCrLf & _
"<td>" & m & "</td>" & vbCrLf & _
"<td>" & E & "</td>"
Close #1
End If
'时间控件开启
Timer1.Enabled = True
End Sub
Private Sub Command3_Click()
'进行中的任务暂停
Timer1.Enabled = False
'记录暂停时间
m = Date & Time
End Sub
Private Function Rndz(a1 As Long, b1 As Long)
Rndz = Int((a1 - b1 + 1) * Rnd() + b1)
End Function
Private Sub Form_Load()
Randomize
a9 = Rndz(1, 10)
'皮肤初始化
On Error Resume Next
File1.Path = App.Path & "\SkinSharp"
SkinH_Attach
SkinH_SetAero 1
SkinH_AttachEx App.Path & "\skin" & "\" & a9 & ".she", ""
SkinH_AttachEx Command, ""
'时间控件暂停
Timer1.Enabled = False
Timer4.Enabled = False
c = Format(Now, "yyyymmdd") '把当前系统时间(年月日)赋给c,
Open App.Path & "\c.log" For Append As #1 '同一个文件多次添加文本内容
Randomize
Print #1, "<p align='center'></p>" & vbCrLf & _
"<table border='1px'align='center'" & vbCrLf & _
"bordercolor='blue' width='600px' height='100px'>" & vbCrLf & _
"<tr align='center'>" & vbCrLf & _
"<td>内容</td>" & vbCrLf & _
"<td >开始时间</td>" & vbCrLf & _
"<td >结束时间</td>"
Close #1
'皮肤文件路径读取
SkinH_AttachEx App.Path & "\skin" & "\" & a9 & ".she", ""
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim da() As Byte, da1() As String
Dim ix&, issame As Boolean '定义各种变量
issame = False
Open App.Path & "\c.log" For Binary As #1
ReDim da(LOF(1) - 1) As Byte
Get #1, , da '取得文件的数据
Close #1
da1 = Split(StrConv(da, vbUnicode), vbCrLf) '将数据转换并以回车分割
'你也可以用其他方法获取文件的每行数据。不过这个方法可能比较快
For ix = 0 To UBound(da1) '将每行数据和text的内容做对比
If da1(ix) = "<p align='center'></p>" Then '& vbCrLf & _
"<table border='1px'align='center'" & vbCrLf & _
"bordercolor='blue' width='600px' height='100px'>" & vbCrLf & _
"<tr align='center'>" & vbCrLf & _
"<td>内容</td>" & vbCrLf & _
"<td >开始时间</td>" & vbCrLf & _
"<td >结束时间</td>" Then '如果有相同的内容就做个标记并退出循环
issame = True: Exit For
End If
Next ix
If issame = False Then '如果不相同就写入text的内容
Open App.Path & "\c.log" For Append As #1
Print #1, "<p align='center'></p>" '& vbCrLf & _
"<table border='1px'align='center'" & vbCrLf & _
"bordercolor='blue' width='600px' height='100px'>" & vbCrLf & _
"<tr align='center'>" & vbCrLf & _
"<td>内容</td>" & vbCrLf & _
"<td >开始时间</td>" & vbCrLf & _
"<td >结束时间</td>"
Close #1
'Else '否则给提示
'MsgBox "已有相同记录"
End If
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
End Sub