06 graduation project-exporting Word documents using VB

Private sub docout_click () 'export word button
If rs1.recordcount <1 then
Msgbox "Export failed. There is no record in the current list! "
Outstate1.visible = false
Exit sub
End if

On Error goto not_installword 'error handling when wordsoftware Is Not Installed
If msgbox (CHR (13) + "export the data in the current list as word data? ", Vbquestion + vbyesno) = vbno then exit sub

dim wdapp as word. application 'defines the word variable
dim wddoc 'defines Word document variables
dim wdtable 'defines the word table variable
dim fieldlen () 'length of the stored field value
dim fieldlen1 as integer" stores the maximum width of each column
dim fieldvalue as string
dim irow, icol as integer
dim irowcount, icolcount as integer 'stores the number of rows and column values
main. enabled = false
outstate1.visible = true' display export status
outstate1.caption =" exporting... "
with RS1

. Movelast
Irowcount =. recordcount + 2' total number of records
Icolcount =. Fields. Count 'total number of fields
. Movefirst
End

'Redefine the number of Columns
Redim fieldlen (icolcount)
'Add a Word document and table
Set wdapp = new word. Application
Wdapp. Documents. add' create a Word document
Set wdtable = wdapp. selection. Tables. Add (wdapp. selection. Range, irowcount + 1, icolcount, wdword9tablebehavior, wdautofitfixed)
With RS1
'Read the title width as the column width Initial Value
For icol = 1 to icolcount
Fieldlen (icol) = lenb (strconv (. Fields (icol-1). Name, vbfromunicode ))
Next icol
For irow = 1 to irowcount
For icol = 1 to icolcount
'Read the field value and return the text type
If. Fields (icol-1). value <> "then
If. Fields (icol-1). type = 10 then
Fieldvalue = trim (. Fields (icol-1). value)
Else
Fieldvalue = CSTR (. Fields (icol-1). value)
End if
Else
Fieldvalue = ""
End if
Select case irow
Case 1
'Line 1 of the behavior title, which is set later
Case 2 'Insert the field name in the second row
Wdtable. Cell (irow, icol). range. insertafter (. Fields (icol-1). Name)
'Set the field name to center
Wdtable. Cell (irow, icol). range. paragraphformat. Alignment = wdalignparagraphcenter
'Set the font to bold.
Wdtable. Cell (irow, icol). range. Font. Bold = wdtoggle
Case else' insert records from the third row
'Calculates the length of the field value. The unit of the returned value is the byte length.
Fieldlen1 = lenb (strconv (fieldvalue, vbfromunicode ))
'Automatically set the table column width
If fieldlen (icol) <fieldlen1 then
'Table column width equals long Field Length
Wdtable. Columns (icol). preferredwidth = 8 * fieldlen1 'word table
'Array fieldlen (icol) stores the maximum Field Length Value
Fieldlen (icol) = fieldlen1
Else
'Table column width is equal to the current field width
Wdtable. Columns (icol). preferredwidth = 8 * fieldlen (icol)
End if
'Write field values to table cells
Wdtable. Cell (irow, icol). range. insertafter (fieldvalue)
'Set the word center in the cell
Wdtable. Cell (irow, icol). range. paragraphformat. Alignment = wdalignparagraphcenter
End select

Doevents
Next icol
If irow> 2 then
If not. EOF then. movenext
End if
Doevents
Outstate1.caption = "exporting... Finished:" + CSTR (INT (100 * irow/irowcount) + "%" 'display export progress
Next irow
'Add year, month, and day
Wdtable. Cell (irowcount + 1, 1). range. insertafter (format $ (now, "Mm DD, YYYY") 'is added to the end of the last row as year, month, and day.
Wdtable. Rows (irowcount + 1). cells. merge' merge the last row
Wdtable. Cell (irowcount + 1, 1). range. paragraphformat. Alignment = wdalignparagraphright

Wdtable. Rows (1). cells. Merge 'merge the first row table
If usetype = "System Administrator" then
Wdtable. Cell (1, 1). range. insertafter ("title name") 'merge and insert the title
Else
Wdtable. Cell (1, 1). range. insertafter (usepart & "title name") 'merge and insert the title
End if
Wdtable. Cell (1, 1). range. Font. Bold = wdtoggle 'set the title to bold
Wdtable. Cell (1, 1). range. Font. size = 14' set the title to font 14.
Wdtable. Cell (1, 1). range. paragraphformat. Alignment = wdalignparagraphcenter'
Wdapp. selection. Tables (1). Rows. Alignment = wdalignrowcenter'

. Movefirst
Wdapp. Visible = true' display Word Table
Set wdapp = nothing: return control to word
End
Outstate1.visible = false
Main. Enabled = true
Exit sub

Not_installword: 'processing when word is not installed on the computer
Msgbox "Export error! Check whether the computer has Word2000 or not! "& CHR (13) & CHR (10) &" then check whether the error record is correct! "
Outstate1.visible = false
Main. Enabled = true
End sub