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 |
