Insert database recordset into word table cells

Recently there is a request to develop a macro which will retrieve data from database then fill into a word table cells.

1. before the real insert, it will popup a form which included a list with all the items, then pick up one item among them and trigger the following macro, the parameter “ID” will get from the popup form and defined in the module as a public variable.

2. There is maybe a requirement to customize the page margin size for this page only as the word table may need more spaces to contain content.
So the following statement will help to apply the page setting to selected content or every pages.

‘ApplyPropsTo:=4 is applied to whole page, =3 applied to selected text

    OQPPeriodSelect.Show
    
'    WordBasic.PageSetupMargins Tab:=0, PaperSize:=0, TopMargin:="0.3", _
'        BottomMargin:="0.4", LeftMargin:="0.5", RightMargin:="0.5", Gutter:="0", _
'        PageWidth:="8.5", PageHeight:="11", Orientation:=0, FirstPage:=0, _
'        OtherPages:=0, VertAlign:=0, ApplyPropsTo:=4, FacingPages:=0, _
'        HeaderDistance:="0.5", FooterDistance:="0.5", SectionStart:=2, _
'        OddAndEvenPages:=0, DifferentFirstPage:=0, Endnotes:=0, LineNum:=0, _
'        CountBy:=0, TwoOnOne:=0, GutterPosition:=0, LayoutMode:=0, DocFontName:= _
'        "", FirstPageOnLeft:=0, SectionType:=1, FolioPrint:=0, ReverseFolio:=0, _
'        FolioPages:=1

    Selection.Font.Name = "Times New Roman"
    Selection.Font.Size = 8
    Selection.TypeText Text:="5. QUESTION PERIOD FOR:" & vbTab & "July 30th, 2012"
    Selection.TypeParagraph
'
    ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=44, NumColumns _
        :=7, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed
    With Selection.Tables(1)
        If .Style <> "Table Grid" Then
            .Style = "Table Grid"
        End If
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
        .ApplyStyleRowBands = True
        .ApplyStyleColumnBands = False
    End With
    

    Selection.Tables(1).Columns(1).PreferredWidthType = wdPreferredWidthPoints
    Selection.Tables(1).Columns(1).PreferredWidth = InchesToPoints(0.45)
    Selection.Move Unit:=wdColumn, Count:=1
    Selection.SelectColumn
    Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
    Selection.Columns.PreferredWidth = InchesToPoints(3.06)
    Selection.Move Unit:=wdColumn, Count:=1
    Selection.SelectColumn
    Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
    Selection.Columns.PreferredWidth = InchesToPoints(0.45)
    Selection.Move Unit:=wdColumn, Count:=1
    Selection.SelectColumn
    Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
    Selection.Columns.PreferredWidth = InchesToPoints(0.45)
    Selection.Move Unit:=wdColumn, Count:=1
    Selection.SelectColumn
    Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
    Selection.Columns.PreferredWidth = InchesToPoints(0.45)
    Selection.Move Unit:=wdColumn, Count:=1
    Selection.SelectColumn
    Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
    Selection.Columns.PreferredWidth = InchesToPoints(1)
    Selection.Move Unit:=wdColumn, Count:=1
    Selection.SelectColumn
    Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
    Selection.Columns.PreferredWidth = InchesToPoints(1.4)
    Selection.Collapse Direction:=wdCollapseStart
    Selection.Move Unit:=wdColumn, Count:=-1
    Selection.SelectColumn
    Selection.Rows.HeightRule = wdRowHeightAtLeast

    
    
    
    Dim conn As ADODB.Connection
    Dim strConn As String
    Dim strSQL As String
    Dim rs As ADODB.Recordset
    Dim totalcount As Integer
    Dim colnum, rownum As Integer
    
    strConn = "Provider=SQLOLEDB.1; Data Source=dbserver\dbinstance;Initial Catalog=dbName; Integrated Security=SSPI;"
    'Set conn = New ADODB.Connection
    'conn.Open strConn
    
    'Dim cmd As ADODB.Command
    'Set cmd = New ADODB.Command
    'cmd.ActiveConnection = conn
    
    'cmd.CommandType = adCmdStoredProc
    'cmd.CommandType = adCmdText
    'cmd.Parameters.Refresh
    'cmd.Parameters(1).Value = CInt(id)
    'cmd.Parameters(2).Value = 1
    'Set rs = cmd.Execute()
    
    strSQL = "select * from testdb"
    Set conn = New ADODB.Connection
    conn.Open strConn
    Set rs = conn.Execute(strSQL)
    
    colnum = 0
    rownum = 1
        
    Do While Not rs.EOF
    
'      ActiveDocument.Tables(1).Rows(rownum).Cells(1).Range.Font.Name = "Times New Roman"
'      ActiveDocument.Tables(1).Rows(rownum).Cells(1).Range.Font.Size = 12
      ActiveDocument.Tables(1).Rows(rownum).Cells(1).Range.Text = rs("column1")
      
'      ActiveDocument.Tables(1).Rows(rownum).Cells(2).Range.Font.Name = "Times New Roman"
'      ActiveDocument.Tables(1).Rows(rownum).Cells(2).Range.Font.Size = 12
      ActiveDocument.Tables(1).Rows(rownum).Cells(2).Range.Text = rs("column2")
      
'      ActiveDocument.Tables(1).Rows(rownum).Cells(3).Range.Font.Name = "Times New Roman"
'      ActiveDocument.Tables(1).Rows(rownum).Cells(3).Range.Font.Size = 12
      ActiveDocument.Tables(1).Rows(rownum).Cells(3).Range.Text = rs("column3")
      
'      ActiveDocument.Tables(1).Rows(rownum).Cells(4).Range.Font.Name = "Times New Roman"
'      ActiveDocument.Tables(1).Rows(rownum).Cells(4).Range.Font.Size = 12
      ActiveDocument.Tables(1).Rows(rownum).Cells(4).Range.Text = rs("column4")
      
'      ActiveDocument.Tables(1).Rows(rownum).Cells(5).Range.Font.Name = "Times New Roman"
'      ActiveDocument.Tables(1).Rows(rownum).Cells(5).Range.Font.Size = 12
      ActiveDocument.Tables(1).Rows(rownum).Cells(5).Range.Text = rs("column5")
      
'      ActiveDocument.Tables(1).Rows(rownum).Cells(6).Range.Font.Name = "Times New Roman"
'      ActiveDocument.Tables(1).Rows(rownum).Cells(6).Range.Font.Size = 12
      ActiveDocument.Tables(1).Rows(rownum).Cells(6).Range.Text = rs("column6")
      
'      ActiveDocument.Tables(1).Rows(rownum).Cells(7).Range.Font.Name = "Times New Roman"
'      ActiveDocument.Tables(1).Rows(rownum).Cells(7).Range.Font.Size = 12
      ActiveDocument.Tables(1).Rows(rownum).Cells(7).Range.Text = rs("column7")
      rs.MoveNext
      rownum = rownum + 1
    Loop
    
   conn.Close
    
    
        
    ActiveDocument.Bookmarks("\page").Range.Select
    

'    ActiveDocument.PageSetup.RightMargin = "0.5"
'    ActiveDocument.PageSetup.LeftMargin = "0.5"
'    ActiveDocument.PageSetup.TopMargin = "0.3"
'    ActiveDocument.PageSetup.BottomMargin = "0.4"


     'ApplyPropsTo:=4 is applied to whole page, =3 applied to selected text
     
WordBasic.PageSetupMargins Tab:=0, PaperSize:=0, TopMargin:="0.3", _
    BottomMargin:="0.4", LeftMargin:="0.5", RightMargin:="0.5", Gutter:="0", _
    PageWidth:="8.5", PageHeight:="11", Orientation:=0, FirstPage:=0, _
    OtherPages:=0, VertAlign:=0, ApplyPropsTo:=4, FacingPages:=0, _
    HeaderDistance:="0.5", FooterDistance:="0.5", SectionStart:=2, _
    OddAndEvenPages:=0, DifferentFirstPage:=0, Endnotes:=0, LineNum:=0, _
    CountBy:=0, TwoOnOne:=0, GutterPosition:=0, LayoutMode:=0, DocFontName:= _
    "", FirstPageOnLeft:=0, SectionType:=1, FolioPrint:=0, ReverseFolio:=0, _
    FolioPages:=1


    ActiveDocument.Tables(1).Rows.Height = InchesToPoints(0.21)
    Selection.Font.Name = "Times New Roman"
    Selection.Font.Size = 12
Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s