1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140
| Option Explicit
Dim word
Dim document
Dim AddinObj
Dim strErrorMsg
strErrorMsg = ""
Call DoWork
' Write the log to disk
Call WriteLogFile ' (Comment out this line if you don't want a log file to be written.)
Set AddinObj = Nothing
' Close the document
document.Close
set document = Nothing
' Shut down Microsoft Word
word.Quit
set word = Nothing
Sub DoWork()
On Error Resume Next
'----
' Start up Microsoft Word
'----
Set word = wscript.CreateObject("Word.Application")
If CheckError("CreateObject") = True Then
Exit Sub
End If
Word.visible = false
word.DisplayAlerts = 0
'-----
' open the document
'-----
Dim collection
Set collection = word.Documents
Set document = collection.Open("C:\Modele.doc")
Set collection = Nothing
If CheckError("Documents.Open") = True Then
Exit Sub
End If
'-----
' get ahold of the SAS Addin COM object
'-----
Dim SASAddin
Set SASAddin = word.COMAddIns("SAS.OfficeAddin.Loader.ConnectProxy")
Set AddinObj = SASAddin.Object
Set SASAddin = Nothing
'-----
' refresh the document
'-----
AddinObj.Refresh( document )
If CheckError("Addin.Refresh") = True Then
Exit Sub
End If
'Lancement de la macro
word.Run " 'Modele_Corevih.doc'!Legende"
'-----
' Save the newly refreshed document
'-----
'document.Save
'If CheckError("document.Save") = True Then
' Exit Sub
'End If
'-----
' Email the newly refreshed document to the designated recipients
'-----
Call SendEmail
If Checkerror("AddinObj.SendMail") = True Then
Exit Sub
End If
'-----
' Perform SaveAs action as specified in delivery options.
'-----
Call SaveToFile
If Checkerror("document.SaveAs") = True Then
Exit Sub
End If
End Sub
Sub WriteLogFile()
Dim fileName
Dim dateTime
dateTime = Replace( FormatDateTime(Now(), vbShortDate), "/", "-" ) + " " + Replace( FormatDateTime(Now(), vbShortTime), ":", "" )
filename = "C:\Log " + dateTime + ".txt"
Dim fsObj
Dim log
Set fsObj = CreateObject("Scripting.FileSystemObject")
Set log = fsObj.CreateTextFile(filename, True)
If strErrorMsg <> "" then
log.WriteLine( strErrorMsg )
log.WriteBlankLines(2)
End If
If AddinObj.Log <> "" Then
log.Write( AddinObj.Log )
End If
End Sub
Function CheckError(fnName)
CheckError = False
Dim errNum
If Err.Number <> 0 Then
strErrorMsg = "Error #" & Hex(Err.Number) & vbCrLf & "In Function " & fnName & vbCrLf & Err.Description
'MsgBox strErrorMsg 'Uncomment this line if you want to be notified via MessageBox of Errors in the script.
CheckError = True
End If
End Function
Sub SendEmail()
Dim recipients
recipients = "byby@yahoo.fr"
Dim subject
subject = "Rapport Word Généré"
Dim message
message = "Veuillez trouver ci-joint le rapport généré"
AddinObj.SendMail document, recipients, "", subject, message
End Sub
Sub SaveToFile()
Dim filename
filename = "C:\Rapport.doc"
document.SaveAs( filename )
End Sub |
Partager