大家好，欢迎来到IT知识分享网。
前几天，有个朋友想要个类似桌面提醒窗口的功能，具体点就是读取指定的excel里的数据，根据里面的时间段来显示不同的内容
计划示例
于是乎，我便想到用VBS来写个这样的功能，但VBS运行后是没有类似其他软件那样的界面的，那么如果有个界面是不是会更好一点呢，所以最终我选择把文件格式改成hta，这样就可以实现下方的效果。
小功能界面
只需要输入想要读取的excel的完整名字，点击开启提醒后，只要到了时间点，就会弹出提示框显示你需要做的事，不过这个只适合用电脑办公的人员，毕竟没了电脑，你想运行也木得运行。
提示框内容
点击确定后的程序界面
如果不需要提醒了，点击关闭提醒按钮，会出现确认面板，点击确定便可关闭提醒，或者直接点击程序界面右上角的“X”按钮。
关闭提醒的确认面板
以上是效果，接下来便是代码了。
首先定义好窗口的属性以及需要显示的文本和按钮，具体可以看以下链接
https://blog.csdn.net/qq_42010059/article/details/105635006
<head>
<title>定时提醒</title>
<HTA:APPLICATION
APPLICATIONNAME="HTA Test"
Border="thin"
borderStyle="sunken"
ICON="C:\WINDOWS\SYSTEM32\control.exe"
SCROLL="no"
SINGLEINSTANCE="yes"
MaximizeButton="no"
WINDOWSTATE="normal">
</head>然后就可以写VBS的代码了
<script language="VBScript">
me.resizeto 210,200
me.moveto (1366 - 210)/2, (768 - 200)/2
SetInterval "LoopMain", 1000
dim isStart
dim excelPath, txtPath, txtData
dim oExcel, oWb, oSheet
dim userName
dim timer, curCol, curRow, maxColumns, maxRows, curKey, lastKey
isStart = false
lastKey = -1
curKey = 0
set wsnet = CreateObject("wscript.network")
userName = wsnet.username
txtPath = "记事本临时数据.txt"
sub OpenExcel()
'将excel数据转换至txt
Set oExcel = CreateObject("Excel.Application")
Set oWb = oExcel.Workbooks.Open("C:\Users\" & userName & "\Desktop\" & excelPath)
Set oSheet = oWb.Sheets(1)
LoadExcelDataToTxt
oWb.close
oExcel.Quit
Set owb = Nothing
Set oExcel = Nothing
txtData = GetFile(txtPath)
DeleteFile txtPath
end sub
'数据转换
sub LoadExcelDataToTxt()
maxColumns = oSheet.UsedRange.Columns.Count
maxRows = oSheet.UsedRange.Rows.Count
Dim i, j, k
Dim tempKey, tempVal, str, cysVal, czrVal
For i = 1 To maxColumns
For j = 1 To maxRows
If oSheet.Cells(j, i).Value = "时间段" Then
curCol = i
curRow = j
Exit For
End If
Next
Next
dim content
content = GetColumnByLabel("内容")
For k = curRow + 1 To maxRows
tempKey = oSheet.Cells(k, curCol).Value
tempVal = oSheet.Cells(k, content).Value
str = str & tempKey & "|" & tempVal & vbCrlf
Next
WriteFile txtPath, str
end sub
function GetColumnByLabel(label)
For i = 1 To maxColumns
For j = 1 To maxRows
If oSheet.Cells(j, i).Value = label Then
GetColumnByLabel = i
Exit For
End If
Next
Next
end function
'读取文件
function GetFile(txtName)
if txtName <> "" then
dim fs, txt
Set fs = CreateObject("Scripting.FileSystemObject")
Set txt = fs.OpenTextFile(txtName)
GetFile = txt.ReadAll
txt.close
Set fs = nothing
end if
end function
'写入文件
sub WriteFile(txtName, content)
if txtName <> "" then
dim fs, txt
Set fs = CreateObject("Scripting.FileSystemObject")
Set txt = fs.CreateTextFile(txtName)
txt.Write content
txt.close
Set fs = nothing
end if
end sub
'删除文件
sub DeleteFile(txtName)
if txtName <> "" then
dim fs, txt
Set fs = CreateObject("Scripting.FileSystemObject")
if (fs.fileexists(txtName)) Then
fs.deleteFile txtName
end if
Set fs = nothing
end if
end sub
'判断时间段显示相应内容
Sub checkShowMsg()
timer = timer + 1
If timer >= 5 Then
Dim i, itemList, strList
Dim tempVal, startTimeStr, endTimeStr, sTimeOff, eTimeOff, curTimeStr
Dim dialog, copyTxt
itemList = Split(txtData, vbCrlf)
For i = LBound(itemList) To UBound(itemList)
if itemList(i) <> "" then
strList = Split(itemList(i), "|")
tempVal = strList(0)
startTimeStr = Split(tempVal, "-")(0)
endTimeStr = Split(tempVal, "-")(1)
curTimeStr = FormatDateTime(Now(), 4)
sTimeOff = DateDiff("s", startTimeStr, curTimeStr)
eTimeOff = DateDiff("s", curTimeStr, endTimeStr)
If sTimeOff >= 0 And eTimeOff >= 0 And curKey <> tempVal Then
lastKey = tempVal
dialog = dialog & startTimeStr & strList(1) & vbCrlf
copyTxt = copyTxt & startTimeStr & strList(1) & "//"
End If
end if
next
if lastKey <> curKey then
curKey = lastKey
end if
if dialog <> "" then
msgbox dialog, vbSystemModal, "当前时段需要做的事"
copytext.Value = copyTxt
end if
timer = 0
End If
End Sub
sub LoopMain()
if isStart = true then
checkShowMsg
end if
end sub
sub DelayStart
isStart = true
end sub
sub BeginTip
If Text.Value <> "" Then
excelPath = Text.Value
OpenExcel
window.settimeout "DelayStart", 3000
Else
MsgBox "请输入文件路径。"
End If
end sub
sub EndTip
dim isClose
isClose = msgbox("是否关闭提醒", 4097)
if isClose = 1 then
isStart = false
lastKey = -1
curKey = 0
end if
end sub接着便是显示文本和按钮
<body>
文件路径：
<input type="text" name="text" id="text" style="height:23px;width:120px;line-height:20px;border:1px solid #aaa;"/>
<br>可复制文本：
<input type="text" name="copytext" id="copytext" style="height:23px;width:120px;line-height:20px;border:1px solid #aaa;"/>
<div><br><input name="Submit" type="button" style="height:30px;line-height:20px;border:1px solid #aaa;" value="开启提醒" name="run_button" onClick="BeginTip">
<input type="button" style="height:30px;line-height:20px;border:1px solid #aaa;" value="关闭提醒" name="run_button" onClick="EndTip"></div>
<br>
</body>以上便是所有的代码了，只需要在桌面新建文本文档，将所有代码复制进去，另存为编码为ANSI后，将后缀名改成hta即可，双击该文件便能看到上面的效果。
免责声明：本站所有文章内容,图片，视频等均是来源于用户投稿和互联网及文摘转载整编而成，不代表本站观点，不承担相关法律责任。其著作权各归其原作者或其出版社所有。如发现本站有涉嫌抄袭侵权/违法违规的内容,侵犯到您的权益，请在线联系站长,一经查实,本站将立刻删除。 本文来自网络,若有侵权，请联系删除，如若转载，请注明出处：https://yundeesoft.com/52037.html
