1  '==============================================================

 2  ' AutoSaveText Script

 3 

 4  ' 通过快捷键调用此脚本，能自动保存选中的文本到指定文件

 5 

 6  '                      -- by lifesinger  April 19th, 2006

 7  '==============================================================

 8  Option Explicit

 9  Dim Appending, LineSeparator, strTime, SaveFilePath, AutoOpen

10 

11 

12  '------------- 以下是配置，你可以根据需要更改 ------------->

13  Appending = True

14  ' True   -- append to the end of the file  将内容追加到文件末尾

15  ' False  -- overwrite previous contents    从头写起，覆盖原有内容

16 

17  strTime = FormatDateTime(Date, 1) & FormatDateTime(Now, 3)

18  ' 时间格式 取 1, 3 时，格式为 2006年4月19日18:38:02

19  LineSeparator = "------------- 以下内容于 " & strTime & " 添加 --------------"

20  ' 和之前内容的分割线

21 

22  SaveFilePath = "AutoSaveText.txt"

23  ' 保存内容的文件路径，可以是绝对路径或相对路径

24 

25  AutoOpen = True

26  ' True  -- 将内容保存到文件后，调用默认编辑器打开文件

27  ' False -- 仅保存内容，不打开文件

28 

29  '------------------------- 配置结束 -------------------------<

30 

31 

32 

33  '>-------- 注意：如果不懂VBS，请不要修改下面的代码 -----------<

34 

35  Dim ScriptPath, fso, f, oShell, oIE, strText, strLine, i

36  Const ForReading = 1, ForWriting = 2, ForAppending = 8

37  ScriptPath = Left(WScript.ScriptFullName, (Len(WScript.ScriptFullName) - Len(WScript.ScriptName)))

38 

39  Set fso = CreateObject("Scripting.FileSystemObject")

40  Set oShell=WScript.CreateObject("WScript.Shell")

41 

42  '将选中的内容复制到剪贴板

43  oShell.SendKeys "(^c)"

44  Set oIE = CreateObject("InternetExplorer.Application")

45  oIE.Navigate("about:blank")

46  strText = oIE.document.parentwindow.clipboardData.getData("text")

47  oIE.Quit

48 

49 

50  '将内容写入文件, 编码为Unicode

51  If Appending Then

52    Set f = fso.OpenTextFile(SaveFilePath, ForAppending, True, -1)

53  Else

54    Set f = fso.OpenTextFile(SaveFilePath, ForWriting, True, -1)

55  End If

56 

57  If(Len(strText) > 0) Then

58    f.WriteLine

59    f.WriteLine

60    f.WriteLine LineSeparator

61    f.WriteLine

62    strLine = Split(strText, vbCrLf)

63    For i = 0 to Ubound(strLine)

64          f.Write CStr(strLine(i)) & vbCrLf

65    Next

66  Else

67    f.Write ""

68  End If

69 

70  f.Close

71 

72 

73  '用默认编辑器打开文件

74  If AutoOpen Then

75    oShell.Run SaveFilePath, 5, false

76  End If

77 

78  Set oShell = Nothing

79  WScript.Quit

80 

81  '>--------------------------- SCRIPT END ---------------------------<