<% Option Explicit %>
<html>
<head>
<title>ThaiCreate.Com ASP & Word.Application</title>
</head>
<body>
<%
Const wdAlignParagraphCenter = 1
Const wdAlignParagraphRight = 2
Dim Wrd,WrdDoc,DocName,objTable
Dim Conn,strSQL,objRec,arrCus,intRows
Dim MyRange1,MyRange2,MyRange3
Set Wrd = CreateObject("Word.Application")
DocName = "MyDoc/MyWord.doc"
Wrd.Application.Visible = False
Set WrdDoc = Wrd.Documents.Open(Server.MapPath("thaicreate.dot"))
Set MyRange1 = WrdDoc.Paragraphs.Add.Range
With MyRange1
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Font.Name = "Verdana"
.Font.Size = "20"
.Font.Bold = True
.InsertBefore("Customer Report"&vbCrLf)
End With
Set Conn = Server.Createobject("ADODB.Connection")
Conn.Open "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & Server.MapPath("mydatabase.mdb"),"" , ""
strSQL = "SELECT * FROM customer "
Set objRec = Server.CreateObject("ADODB.Recordset")
objRec.Open strSQL, Conn, 1,3
If Not objRec.EOF and Not objRec.BOF Then
arrCus = objRec.GetRows()
End If
Set MyRange2 = WrdDoc.Paragraphs.Add.Range
With MyRange2
.Font.Size = "10"
End With
Set objTable = Wrd.ActiveDocument.Tables.Add(MyRange2,Ubound(arrCus),6,1,2) '** Range,Rows,Column **'
'*** Header ***'
objTable.Cell(1,1).Range.InsertAfter("CustomerID")
objTable.Cell(1,1).Range.Bold = True
objTable.Cell(1,1).Range.ParagraphFormat.Alignment = 1
objTable.Cell(1,2).Range.InsertAfter("Name")
objTable.Cell(1,2).Range.Bold = True
objTable.Cell(1,2).Range.ParagraphFormat.Alignment = 1
objTable.Cell(1,3).Range.InsertAfter("Email")
objTable.Cell(1,3).Range.Bold = True
objTable.Cell(1,3).Range.ParagraphFormat.Alignment = 1
objTable.Cell(1,4).Range.InsertAfter("CountryCode")
objTable.Cell(1,4).Range.Bold = True
objTable.Cell(1,4).Range.ParagraphFormat.Alignment = 1
objTable.Cell(1,5).Range.InsertAfter("Budget")
objTable.Cell(1,5).Range.Bold = True
objTable.Cell(1,5).Range.ParagraphFormat.Alignment = 1
objTable.Cell(1,6).Range.InsertAfter("Used")
objTable.Cell(1,6).Range.Bold = True
objTable.Cell(1,6).Range.ParagraphFormat.Alignment = 1
'*** Detail ***
For intRows = 0 To Ubound(arrCus,2)
objTable.Cell(intRows+2,1).Range.InsertAfter(arrCus(0,intRows))
objTable.Cell(intRows+2,1).Range.ParagraphFormat.Alignment = 1
objTable.Cell(intRows+2,2).Range.InsertAfter(arrCus(1,intRows))
objTable.Cell(intRows+2,2).Range.ParagraphFormat.Alignment = 0
objTable.Cell(intRows+2,3).Range.InsertAfter(arrCus(2,intRows))
objTable.Cell(intRows+2,3).Range.ParagraphFormat.Alignment = 0
objTable.Cell(intRows+2,4).Range.InsertAfter(arrCus(3,intRows))
objTable.Cell(intRows+2,4).Range.ParagraphFormat.Alignment = 1
objTable.Cell(intRows+2,5).Range.InsertAfter(FormatNumber(arrCus(4,intRows),2))
objTable.Cell(intRows+2,5).Range.ParagraphFormat.Alignment = 2
objTable.Cell(intRows+2,6).Range.InsertAfter(FormatNumber(arrCus(5,intRows),2))
objTable.Cell(intRows+2,6).Range.ParagraphFormat.Alignment = 2
Next
Set MyRange3 = WrdDoc.Paragraphs.Add.Range
With MyRange3
.ParagraphFormat.Alignment = wdAlignParagraphRight
.Font.Name = "Verdana"
.Font.Size = "10"
.InsertBefore(vbCrLf&vbCrLf&vbCrLf&"..........................Manager"&vbCrLf&Now())
End With
WrdDoc.SaveAs(Server.MapPath(DocName))
Wrd.Application.Quit
Set Wrd = Nothing
'**************** Send Email ******************'
Dim myMail,HTML,strMsg
Set myMail = Server.CreateObject("CDONTS.NewMail")
If Trim(DocName) <> "" Then
myMail.AttachFile Server.MapPath(DocName)
End If
myMail.From = "Webmaster <[email protected]>"
myMail.Value("Reply-To") = "[email protected]"
myMail.To = "[email protected]"
myMail.Subject = "My Word"
myMail.MailFormat = 0
myMail.BodyFormat = 0
myMail.Body = "Convert to Word Document"
myMail.Send
Set myMail = Nothing
'*************** End Send Email ***************'
Response.write"Generate Word and Email Sending."
%>
</body>
</html>
ช่วยกันสนับสนุนรักษาเว็บไซต์ความรู้แห่งนี้ไว้ด้วยการสนับสนุน 
Load balance : Server 04
