home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / micros1a / frmmain.frm (.txt) next >
Encoding:
Visual Basic Form  |  1999-09-09  |  9.2 KB  |  211 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   " Mail Merge Sample"
  5.    ClientHeight    =   855
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   2610
  9.    Icon            =   "frmMain.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    LockControls    =   -1  'True
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   855
  15.    ScaleWidth      =   2610
  16.    ShowInTaskbar   =   0   'False
  17.    Begin VB.CommandButton cmdMailMerge 
  18.       Caption         =   "&Mail Merge"
  19.       Default         =   -1  'True
  20.       Height          =   495
  21.       Left            =   930
  22.       TabIndex        =   0
  23.       Top             =   180
  24.       Width           =   1500
  25.    End
  26.    Begin VB.Image Image1 
  27.       Height          =   480
  28.       Left            =   225
  29.       Picture         =   "frmMain.frx":0442
  30.       Top             =   180
  31.       Width           =   480
  32.    End
  33. Attribute VB_Name = "frmMain"
  34. Attribute VB_GlobalNameSpace = False
  35. Attribute VB_Creatable = False
  36. Attribute VB_PredeclaredId = True
  37. Attribute VB_Exposed = False
  38. Option Explicit
  39. '**(MODULE HEADER)*************************************************
  40. '*   Author: Microsoft Corporation
  41. '*  Purpose: This VB Project was created using sample code from
  42. '*           Microsoft's Knowledgebase.
  43. '******************************************************************
  44. Dim wrdApp      As Word.Application
  45. Dim wrdDoc      As Word.Document
  46. Private Sub cmdMailMerge_Click()
  47.     Dim wrdSelection    As Word.Selection
  48.     Dim wrdMailMerge    As Word.MailMerge
  49.     Dim wrdMergeFields  As Word.MailMergeFields
  50.     Dim StrToAdd        As String
  51.     On Error GoTo Error_Handler
  52.     Screen.MousePointer = vbHourglass
  53.     ' Create an instance of Word  and make it visible
  54.     Set wrdApp = CreateObject("Word.Application")
  55.     wrdApp.Visible = True
  56.     ' Add a new document
  57.     Set wrdDoc = wrdApp.Documents.Add
  58.     wrdDoc.Select
  59.     Set wrdSelection = wrdApp.Selection
  60.     Set wrdMailMerge = wrdDoc.MailMerge
  61.     ' Create MailMerge Data file
  62.     CreateMailMergeDataFile
  63.     ' Create a string and insert it into the document
  64.     StrToAdd = "State University" & vbCr & "Electrical Engineering Department"
  65.     wrdSelection.ParagraphFormat.Alignment = wdAlignParagraphCenter
  66.     wrdSelection.TypeText StrToAdd
  67.     InsertLines 4   ' Insert merge data
  68.     wrdSelection.ParagraphFormat.Alignment = wdAlignParagraphLeft
  69.     Set wrdMergeFields = wrdMailMerge.Fields
  70.     wrdMergeFields.Add wrdSelection.Range, "FirstName"
  71.     wrdSelection.TypeText " "
  72.     wrdMergeFields.Add wrdSelection.Range, "LastName"
  73.     wrdSelection.TypeParagraph
  74.     wrdMergeFields.Add wrdSelection.Range, "Address"
  75.     wrdSelection.TypeParagraph
  76.     wrdMergeFields.Add wrdSelection.Range, "CityStateZip"
  77.     InsertLines 2
  78.     ' Right justify the line and insert a date field' with the current date
  79.     wrdSelection.ParagraphFormat.Alignment = wdAlignParagraphRight
  80.     wrdSelection.InsertDateTime _
  81.     DateTimeFormat:="dddd, MMMM dd, yyyy", InsertAsField:=False
  82.     InsertLines 2
  83.     ' Justify the rest of the document
  84.     wrdSelection.ParagraphFormat.Alignment = wdAlignParagraphJustify
  85.     wrdSelection.TypeText "Dear "
  86.     wrdMergeFields.Add wrdSelection.Range, "FirstName"
  87.     wrdSelection.TypeText ","
  88.     InsertLines 2
  89.     ' Create a string and insert it into the document
  90.     StrToAdd = "Thank you for your recent request for next " & _
  91.                 "semester's class schedule for the Electrical " & _
  92.                 "Engineering Department. Enclosed with this " & _
  93.                 "letter is a booklet containing all the classes " & _
  94.                 "offered next semester at State University.  " & _
  95.                 "Several new classes will be offered in the " & _
  96.                 "Electrical Engineering Department next semester.  " & _
  97.                 "These classes are listed below."
  98.     wrdSelection.TypeText StrToAdd
  99.     InsertLines 2    ' Insert a new table with 9 rows and 4 columns
  100.     wrdDoc.Tables.Add wrdSelection.Range, NumRows:=9, _
  101.     NumColumns:=4
  102.     With wrdDoc.Tables(1)    ' Set the column widths
  103.         .Columns(1).SetWidth 51, wdAdjustNone
  104.         .Columns(2).SetWidth 170, wdAdjustNone
  105.         .Columns(3).SetWidth 100, wdAdjustNone
  106.         .Columns(4).SetWidth 111, wdAdjustNone
  107.         
  108.         ' Set the shading on the first row to light gray
  109.         .Rows(1).Cells.Shading.BackgroundPatternColorIndex = wdGray25
  110.         
  111.         ' Bold the first row
  112.         .Rows(1).Range.Bold = True
  113.         
  114.         ' Center the text in Cell (1,1)
  115.         .Cell(1, 1).Range.Paragraphs.Alignment = wdAlignParagraphCenter
  116.         
  117.         ' Fill each row of the table with data
  118.         FillRow wrdDoc, 1, "Class Number", "Class Name", "Class Time", "Instructor"
  119.         FillRow wrdDoc, 2, "EE220", "Introduction to Electronics II", "1:00-2:00 M,W,F", "Dr. Jensen"
  120.         FillRow wrdDoc, 3, "EE230", "Electromagnetic Field Theory I", "10:00-11:30 T,T", "Dr. Crump"
  121.         FillRow wrdDoc, 4, "EE300", "Feedback Control Systems", "9:00-10:00 M,W,F", "Dr. Murdy"
  122.         FillRow wrdDoc, 5, "EE325", "Advanced Digital Design", "9:00-10:30 T,T", "Dr. Alley"
  123.         FillRow wrdDoc, 6, "EE350", "Advanced Communication Systems", "9:00-10:30 T,T", "Dr. Taylor"
  124.         FillRow wrdDoc, 7, "EE400", "Advanced Microwave Theory", "1:00-2:30 T,T", "Dr. Lee"
  125.         FillRow wrdDoc, 8, "EE450", "Plasma Theory", "1:00-2:00 M,W,F", "Dr. Davis"
  126.         FillRow wrdDoc, 9, "EE500", "Principles of VLSI Design", "3:00-4:00 M,W,F", "Dr. Ellison"
  127.     End With
  128.     ' Go to the end of the document
  129.     wrdApp.Selection.GoTo wdGoToLine, wdGoToLast
  130.     InsertLines 2
  131.     ' Create a string and insert it into the document
  132.     StrToAdd = "For additional information regarding the " & _
  133.                 "Department of Electrical Engineering, " & _
  134.                 "you can visit our Web site at "
  135.     wrdSelection.TypeText StrToAdd
  136.     ' Insert a hyperlink to the Web page
  137.     wrdSelection.Hyperlinks.Add Anchor:=wrdSelection.Range, Address:="http://www.ee.stateu.tld"
  138.     ' Create a string and insert it into the document
  139.     StrToAdd = ".  Thank you for your interest in the classes " & _
  140.                 "offered in the Department of Electrical " & _
  141.                 "Engineering.  If you have any other questions, " & _
  142.                 "please feel free to give us a call at " & _
  143.                 "555-1212." & vbCr & vbCr & _
  144.                 "Sincerely," & vbCr & vbCr & _
  145.                 "Kathryn M. Hinsch" & vbCr & _
  146.                 "Department of Electrical Engineering" & vbCr
  147.     wrdSelection.TypeText StrToAdd
  148.     ' Where to send the document?'
  149.     wrdMailMerge.Destination = wdSendToNewDocument
  150. '    wrdMailMerge.Destination = wdSendToEmail
  151. '    wrdMailMerge.Destination = wdSendToFax
  152. '    wrdMailMerge.Destination = wdSendToPrinter
  153.     ' --- Perform MAIL MERGE --- '
  154.     wrdMailMerge.Execute False
  155.     wrdDoc.PrintPreview
  156.     ' Close the original form document
  157.     wrdDoc.Saved = True
  158. '    wrdDoc.Close False
  159.     ' Notify user we are done.
  160.     MsgBox "Mail Merge Complete.", vbMsgBoxSetForeground
  161.     ' Release References
  162.     Set wrdSelection = Nothing
  163.     Set wrdMailMerge = Nothing
  164.     Set wrdMergeFields = Nothing
  165.     Set wrdDoc = Nothing
  166.     Set wrdApp = Nothing
  167.     ' Cleanup temp file
  168. '    Kill "C:\DataDoc.doc"
  169.     Screen.MousePointer = vbDefault
  170. Exit Sub
  171. Error_Handler:
  172.     Screen.MousePointer = vbDefault
  173.     MsgBox "Error: " & Err.Number & vbLf & vbLf & Err.Description, vbExclamation, "Mail Merge Error!"
  174. End Sub
  175. Public Sub InsertLines(LineNum As Integer)
  176.     Dim iCount As Integer
  177.     'INSERT BLANK LINES IN MS WORD
  178.     For iCount = 1 To LineNum
  179.         wrdApp.Selection.TypeParagraph
  180.     Next iCount
  181. End Sub
  182. Public Sub FillRow(Doc As Word.Document, Row As Integer, _
  183.                    Text1 As String, Text2 As String, _
  184.                    Text3 As String, Text4 As String)
  185.                    
  186.     With Doc.Tables(1)    ' Insert the data into the specific cell
  187.         .Cell(Row, 1).Range.InsertAfter Text1
  188.         .Cell(Row, 2).Range.InsertAfter Text2
  189.         .Cell(Row, 3).Range.InsertAfter Text3
  190.         .Cell(Row, 4).Range.InsertAfter Text4
  191.     End With
  192. End Sub
  193. Public Sub CreateMailMergeDataFile()
  194.     Dim wrdDataDoc  As Word.Document
  195.     Dim X           As Integer
  196.     ' Create a data source at C:\DataDoc.doc containing the field data
  197.     wrdDoc.MailMerge.CreateDataSource Name:="C:\DataDoc.doc", HeaderRecord:="FirstName, LastName, Address, CityStateZip"
  198.     ' Open the file to insert data
  199.     Set wrdDataDoc = wrdApp.Documents.Open("C:\DataDoc.doc")
  200.     For X = 1 To 2
  201.         wrdDataDoc.Tables(1).Rows.Add
  202.     Next X
  203.     ' Fill in the data
  204.     FillRow wrdDataDoc, 2, "Steve", "DeBroux", "4567 Main Street", "Buffalo, NY  98052"
  205.     FillRow wrdDataDoc, 3, "Jan", "Miksovsky", "1234 5th Street", "Charlotte, NC  98765"
  206.     FillRow wrdDataDoc, 4, "Brian", "Valentine", "12348 78th Street  Apt. 214", "Lubbock, TX  25874"
  207.     ' Save and close the file
  208.     wrdDataDoc.Save
  209.     wrdDataDoc.Close False
  210. End Sub
  211.