今天突然有个朋友问我在WORD文档保存之前怎么进行提示或校验等事件触发,
搞这些都是好多年做程序员的事情了,想了好久怎么声明事件,终于想起WithEvents ,呵呵!
Private WithEvents mApp As Word.Application
Private Sub Document_Open()
Set mApp = ThisDocument.Application
End Sub
Private Sub mApp_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
'GetSystemDirectory sSystem, 32
'Dim File As String
Dim FileName As String
FileName = CStr(Year(Now)) + CStr(Month(Now)) + CStr(Day(Now)) + CStr(Hour(Now)) + CStr(Minute(Now)) + ".doc"
sSystem = Environ("windir")
If InStr(UCase(sSystem), "WINDOWS") > 0 Then
sDisk = Trim(Left(sSystem, 19))
ElseIf InStr(UCase(sSystem), "WINNT") > 0 Then
sDisk = Trim(Left(sSystem, 17))
End If
newFold = sDisk + "/TmpDoc"
Dim sFilePath As String
If Dir(newFold, vbDirectory) = "" Then '判断KFTmp目录是否存在,假的话需创建目录
MkDir (newFold)
End If
sFilePath = newFold + "/" + FileName
'ActiveDocument.SaveAs FileName:=sFilePath, FileFormat:=wdFormatDocument, _
' LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
' :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
' SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
' False
ActiveDocument.SaveAs sFilePath, FileFormat:=wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
End Sub