หากมีคำถาม ขอให้ไปโพสต์ลง เว็บบอร์ดจีทูจีเน็ตดอตคอม ตัวใหม่แทนน่ะครับ

หรือติดต่อเข้ามาทาง Inbox ที่ เฟซบุ๊ค ผมครับ

หน้าหลัก
ข่าวสาร - บทความ ทั้งหมด
VB 6/VB.Net
ASP/ASP.Net
จับฉ่ายคอมพิวเตอร์
เรียนรู้ผ่าน Flash Movie
บทความที่มีผู้ตอบล่าสุด  
 RSS Feeds
 ดาวน์โหลดโปรแกรม RSS Reader ได้ที่นี่ ...   Download โปรแกรม RSS Reader

Forum - www.g2gnet.com
Webmaster - www.g2gnet.com
Visitors - Session views
 5 1 2 8 4 6 4

7 ธันวาคม พ.ศ.2549
246 Users On-Line.
Visitors - Page views
 8 4 2 4 5 0 3
1 กุมภาพันธ์ พ.ศ.2551

Google   
เว็บ g2gnet.com
ขนาดตัวอักษร:  

การทำจดหมายเวียน (Mail Merge) ด้วย MS Visual Basic 6

Category »  VB 6/VB.Net
โดย : Webmaster เมื่อ 12/6/2551 15:15:00
(อ่าน : 24010) 
หลายคนคงคิดว่าการเรียนรู้ ศึกษา พัฒนาโปรแกรมด้วยภาษาต่างๆนั้น คงจะต้องมีอาชีพโปรแกรมเมอร์เพียงอย่างเดียว ผมคิดว่าคงไม่ถูกต้องมากนักหรอกครับ ในชีวิตของการทำงาน ... หลากหลายอย่างที่อยู่รอบตัวเรานั่นแหละ ที่จะนำความรู้ทางด้านนี้มาประยุกต์ใช้งานได้ มันขึ้นอยู่กับว่าคุณ "ได้คิด หรือ ไม่ได้คิด" ... อย่างหลังไม่ขอพูดถึง แต่อย่างแรกเมื่อ "ได้คิด" แล้วจะทำยังไงต่อไปล่ะ ... นั่นก็คือ การแสวงหาความรู้ ยังไงยังล่ะครับ แต่หาอย่างเดียวก็ไม่เพียงพอหรอกครับ มันต้องมีความมุ่งมั่น ขยัน อดทน ... และสำคัญสุดๆก็ต้องใช้ "สมอง" คิดเองไปด้วย เพราะข้อมูลต่างๆที่มีอยู่มากมายในปัจจุบันนี้ ถูกก็เยอะ ผิดก็มีมาก ... ต้องพยายามแยกแยะให้ออกด้วยน่ะครับ ... พี่น้อง (ก็เล่น Copy กันไปๆมาๆ จนหาแหล่งที่มาหรือต้นฉบับจากผู้เขียนจริงๆไม่ได้ หากถูกต้องก็ดีไป แต่หากผิดก็แย่หน่อยล่ะ ... จนกลายมาเป็นคำยอดฮิต "เขาว่ากันว่า ..." ... 55555+)
อ่านรายละเอียดของ การทำจดหมายเวียน (Mail Merge) ด้วย Microsoft Office XP - 2003
ดาวน์โหลด Source Code สำหรับ MS Visual Basic 6.0 - Service Pack 6
 ดาวน์โหลด Visual Basic 6.0 SP5: Run-Time Redistribution Pack
 ดาวน์โหลด Microsoft Data Access Object (MDAC) และ Jet 4.0 Update
 ดาวน์โหลด Microsoft Visual Basic Service Pack 6
จดหมายเวียน หรือ Mail Merge คือ จดหมายที่มีข้อความเดิมๆซ้ำๆกันทุกฉบับ ซึ่งจดหมายแต่ละฉบับนั้นก็จะมีความแตกต่างกันเฉพาะบางส่วนของจดหมายเท่านั้น เช่น ชื่อผู้รับ เป็นต้น ...

แสดงผัง Diagram ลำดับการทำงาน


Project --> References ...


Project --> Components ...


Design Time


Run Time


Option Explicit

' เปิดไฟล์ Document
Dim oDocFile As String

' ตั้งค่า Path ให้มันถูกต้อง
Dim ApplicationPath As String

' Microsoft Word 11.0 Object library
Dim WordApp As Word.Application

' WinAPI สำหรับการคัดลอกไฟล์ข้อมูล (Copy File)
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" ( _
    ByVal lpExistingFileName As String, _
    ByVal lpNewFileName As String, _
    ByVal bFailIfExists As Long) _
  As Long

' ===============================================
' ฟังค์ชั่นที่ใช้เรียก API ในการคัดลอกไฟล์
Private Function APIFileCopy ( _
    Source As String, _
    Destination As String, _
    Optional FailIfDestExists As Boolean _
    ) As Boolean

    Dim lRet As Long
    lRet = CopyFile(Source, Destination, FailIfDestExists)
    ' หากว่า lRet = 0 แสดงว่าเกิดข้อผิดพลาดน่ะครับ ... พี่น้อง
    APIFileCopy = (lRet > 0)

End Function
' ===============================================

' เหตุการณ์ หรือ โปรแกรมย่อยในการเปิดไฟล์ต้นแบบ (Template)
Private Sub cmdOpenDoc_Click()
'On Error Resume Next
On Error GoTo ErrHandler
    
    ' เปิดไฟล์ MS Word
    oDocFile = Trim(txtTemplate.Text) '""
    dlgOpenDoc.FileName = ""
    dlgOpenDoc.InitDir = App.Path
    ' อันนี้ไปดูรายละเอียดเพิ่มเติมจาก MSDN ได้เลยครับ ... พี่น้อง
    dlgOpenDoc.Flags = cdlOFNHideReadOnly + _
                                                cdlOFNOverwritePrompt + _
                                                cdlOFNPathMustExist + _
                                                cdlOFNShareAware
    dlgOpenDoc.DialogTitle = "เลือกไฟล์ Microsoft Word ที่เป็นไฟล์ต้นฉบับ (Template)"
    dlgOpenDoc.Filter = "Microsoft Word (*.doc) | *.doc" ' แสดงผลเฉพาะ MS Word Document
    dlgOpenDoc.CancelError = True ' ไม่สนใจ Error ใดๆ
    dlgOpenDoc.ShowOpen
    dlgOpenDoc.DefaultExt = "*.doc" ' ตั้งค่า MS Word Document เป็น Default
    
    oDocFile = dlgOpenDoc.FileName
    If oDocFile <> "" Then  txtTemplate.Text = oDocFile

ExitProc:
    Exit Sub

ErrHandler:
    ' Error หมายเลข 32755 คือ ผู้ใช้งานกดปุ่ม Cancel เพื่อยกเลิกการเปิดไฟล์
    ' บรรทัด If ... นี้ หมายความว่าไม่ต้องแสดง Error ที่เกิดขึ้น ... จบออกจาก Sub Program ไปเลย
    If Err.Number = 32755 Then Resume ExitProc
    
    MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
    ' หากสั่ง Resume เฉยๆ มันจะไปทำงานบรรทัดต่อจากที่มันเกิด Error น่ะครับ
    Resume ExitProc
    
End Sub

' โปรแกรมย่อยที่ใช้ในการพิมพ์จดหมายเวียน (Mail Merge)
Private Sub cmdMailMerge_Click()
Dim ConnStr As String
Dim Statement As String
Dim FileTemp As String
Dim FileSaveAs As String

'On Error Resume Next
On Error GoTo ErrHandler
    
    If Trim(txtTemplate.Text) = "" Or Len(Trim(txtTemplate.Text)) = 0 Then
        MsgBox "กรุณาเลือกไฟล์ต้นแบบ (Template) ในการทำจดหมายเวียนให้เรียบร้อยก่อนด้วย.", _
                        vbOKOnly + vbExclamation, "รายงานความผิดพลาด"
        Exit Sub
    End If


    ' ข้อมูลในการพิมพ์ ... กรณีนำไปใช้งานจริง ควรทำ Query เพื่อเลือกเฉพาะรายการที่ต้องการ
    Statement = "SELECT * FROM tblCustomer ORDER BY CustomerPK "

    ' สร้างไฟล์ชั่วคราว และกำหนดรูปแบบ เช่น Temp-วันเดือนปี-ชั่วโมงนาทีวินาที
    ' ที่ต้องสร้างไฟล์นี้ก็เพราะต้องป้องกันความผิดพลาด ที่อาจจะมีผลกระทบกับไฟล์ต้นแบบ
    ' พี่น้อง ... อยากได้รูปแบบไหนก็กำหนดเอาเองตามใจชอบของท่านเถิดครับ
    FileTemp = "Temp-" & Format(Date, "ddmmyyyy") & "-" & Format(Time, "hhmmss") & ".Doc"

    Set WordApp = New Word.Application
    ' เริ่มการติดต่อกับ Word
    WordApp.Application.Visible = True
    
    ' คัดลอกไฟล์ต้นแบบ หรือ ต้นฉบับ ไปยังไฟล์ชั่วคราวที่ต้องการแสดงผล
    Call APIFileCopy(txtTemplate, ApplicationPath & FileTemp)
	

MS Word Document Template
' เปิด Document Template (ไฟล์ MS Word ต้นแบบ) WordApp.Documents.Open ApplicationPath & FileTemp ' กำหนดไฟล์ฐานข้อมูล ConnStr = ApplicationPath & "DataBase.MDB" ' ให้ MS Word ติดต่อกับฐานข้อมูล พร้อมกับระบุด้วยว่าจะทำจดหมายเวียน (Mail Merge) With WordApp.ActiveDocument.MailMerge .MainDocumentType = wdNotAMergeDocument .MainDocumentType = wdFormLetters ' รูปแบบการเชื่อมต่อไฟล์ฐานข้อมูล ... ยกมาให้ครบชุดเผื่อเอาไว้ใช้งานอื่นกันไปเลย ... เหอๆๆๆๆ .OpenDataSource Name:=ConnStr, SQLStatement:=Statement, _ ConfirmConversions:=False, ReadOnly:=True, LinkToSource:=True, _ AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _ WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _ Format:=wdOpenFormatAuto, SQLStatement1:="", _ OpenExclusive:=True, SubType:=wdMergeSubTypeAccess ' ส่งข้อมูลออกไปให้ MS Word .Destination = wdSendToNewDocument .SuppressBlankLines = True ' ไม่ต้องหยุด ให้แสดงผลไปให้หมดเลย .Execute Pause:=False End With

เมื่อสั่ง Run เพื่อให้ Mail Merge ทำงาน
' เตรียมตั้งชื่อไฟล์เอกสารใหม่ เพื่อคัดลอก FileTemp ไปยังไฟล์ใหม่ ' หากไม่ใช้วิธีการนี้ผมพบว่าจะทำให้เกิด Run-Time Error 5174 หรือ ไม่สามารถเปิดไฟล์ Mail Merge ได้เลย FileSaveAs = "MailMerge" FileSaveAs = ApplicationPath & FileSaveAs & "-" & _ Format(Date, "ddmmyyyy") & "-" & _ Format(Time, "hhmmss") & ".doc"
' บันทึกไฟล์เป็น (Save As) ให้ไฟล์เอกสารใหม่ ' นั่นคือ การเปลี่ยนชื่อไฟล์จาก ... ' Temp-วันเดือนปี-ชั่วโมงนาทีวินาที (หรือ Documents.item(1)) ... มาเป็น ' MailMerge-วันเดือนปี-ชั่วโมงนาทีวินาที (หรือ Documents.item(2)) WordApp.Documents.Item(1).SaveAs FileSaveAs ' สั่งปิดไฟล์ให้หมด และไม่ต้อง Save As ไฟล์เอกสาร ... ' ไฟล์จะปิดเองโดยอัตโนมัติ และไม่ต้องมาถามให้กวนใจอีกว่าจะ Save หรือไม่ ' หากไม่สั่งปิดจะเกิด Run-Time Error 70 หรือ Permission Denied WordApp.Documents.Item(2).Close False    ' ชื่อไฟล์: MailMerge-วันเดือนปี-ชั่วโมงนาทีวินาที WordApp.Documents.Item(1).Close False    ' ชื่อไฟล์: Temp-วันเดือนปี-ชั่วโมงนาทีวินาที
' แสดงผล MS Word ใหม่อีกครั้ง ... WordApp.Application.Visible = True ' เปิด MS Word (ไฟล์ใหม่ที่บันทึก) WordApp.Documents.Open FileSaveAs ExitProc: ' คืนค่าหน่วยความจำให้กับระบบปฏิบัติการ Set WordApp = Nothing ' ลบไฟล์ชั่วคราว (Temporary) ออกไปด้วยคำสั่ง Kill If Dir$(ApplicationPath & FileTemp) <> "" Then Kill ApplicationPath & FileTemp 'MsgBox "ทำการสร้างจดหมายเวียน (Mail Merge) เรียบร้อยแล้ว." & vbCrLf & vbCrLf & _ "ชื่อไฟล์ : " & FileSaveAs, vbOKOnly + vbInformation, "รายงานสถานะ" End ' หรือ Exit Sub ErrHandler: MsgBox "Error: " & Err.Number & vbCrLf & Err.Description Resume ExitProc End Sub

Private Sub Form_Load()
    Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
    txtTemplate.Text = ""
    
    ' ================= ตั้งค่า Path ให้มันถูกต้อง ===============
    ' หากเป็น Root Directory มันจะมีเครื่องหมาย Back Slash (\) มาด้วย เช่น C:\
    ' หากไม่ใช่ Root Directory ก็จะไม่มีเครื่องหมาย \ ... เช่น C:\Program Files
    ' ตรวจสอบค่าทางขวามือสุดว่ามีเครื่องหมาย Back Slash หรือไม่ ... หากไม่มีก็ให้เพิ่มเข้าไปต่อท้าย
    If Right$(App.Path, 1) <> "\" Then
        ApplicationPath = App.Path & "\"
    Else
        ApplicationPath = App.Path
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set frmMailMerge = Nothing
    End
End Sub
Conclusion:
ตัวอย่างงานในลักษณะแบบนี้ สายงานของกลุ่ม Support ก็สามารถที่จะฝึกฝนการพัฒนาโปรแกรม เพื่อนำไปช่วยให้ผู้ใช้งาน (Users) สามารถทำงานได้มีประสิทธิภาพได้มากขึ้น นั่นคือรวมถึงการได้พัฒนาทักษะของตัวเองไปในตัวด้วยครับพี่น้อง ... หากทั้งชีวิตคิดจะเป็นลูกน้อง ลูกจ้างเขาอยู่ แล้วคุณสามารถทำอะไรๆได้หลากหลายอย่างในคนๆเดียวแล้วล่ะก็ ... นายจ้างที่ไหนเขาก็ชอบ เขาก็กล้าอ้าแขนรับคุณทั้งนั้นแหละครับ ... พี่น้อง

ผมทำฐานเอาไว้ให้แล้ว พี่น้องลองคิดแนวทางเอาไปต่อ-ยอดดูเองทีซิครับ

จี ทู จี เน็ต ดอต คอม - g2gNet Dot Com
เลขทะเบียนพาณิชย์อิเล็กทรอนิกส์ 0407314800231
CopyLeft © 2004 - 2099 g2gNet.Com All rights reserved.
Email: [email protected] หรือ โทร. 08-6862-6560