在WORD文档保存之前进行提示或校验等事件触发

今天突然有个朋友问我在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