VBA execute stored procedure gave “Operation is not allowed when the object is closed”

Recently we have a requirement which use macro to print some recordset value from a database table. Basically the VBA code which reference to DB part in Word Macro is as below


    Dim strSQL As String
    Dim rs As ADODB.Recordset
    Dim totalcount As Integer

    strConn = "Provider=SQLOLEDB.1; Data Source= myserver\myinstance;Initial Catalog=mydb; 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.CommandText = "SpGetSomethingFromSomeDbTable"
    cmd.CommandType = adCmdStoredProc

    cmd.Parameters.Refresh
    cmd.Parameters(1).Value = CInt(divisionid)
    cmd.Parameters(2).Value = 1
    Set rs = cmd.Execute()

    totalcount = 0
    Do While Not rs.EOF
        ReDim Preserve membersFor(totalcount) As memberinfo
        membersFor(totalcount).field1 = RemoveQCInLastName(rs("fieldname1"))
        membersFor(totalcount).field2 = RemoveQCInLastName(rs("fieldname2"))
        membersFor(totalcount).field3 = RemoveQCInLastName(rs("fieldname3"))
        rs.MoveNext
        totalcount = totalcount + 1
    Loop

And part of the stored procedure is as below

if object_id('tempdb..#mytemptable') IS NOT NULL 
drop table #mytemptable

;with table1_CTE 
as(SELECT * FROM
	(SELECT *, ROW_NUMBER() OVER(PARTITION BY field1, field2 ORDER BY FieldDateTime DESC) AS rn
		FROM AnotherDatabase.dbo.table1 WHERE fieldDateTime < @specificdate) as T
 WHERE rn = 1  AND IsFlag = 1
 )
SELECT  m.field3, a.field4, a.field5
into #mytemptable
FROM table1_CTE  m JOIN someothertable a ON m.samefield = a.samefield
WHERE m.field1 = @currentvalue 

When I run macro, the error “Operation is not allowed when the object is closed” popup and stop at line
Set rs = cmd.Execute()

Actually this issue is not due to temp table or CTE table but the insert/delete/update DDL operation in stored procedure. The root reason is the count of the number of rows affected by those DDL statements will return as part of the result set. So the solution is easy and simple just need to add the following behind “AS” before the “BEGIN” in the stored procedure.

SET NOCOUNT ON
SET ANSI_WARNINGS OFF

It took me 2 hours to figure out, hope it is helpful.

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

How to use “Object” in VBA

1. The class ancestor– “User Defined Type” in VBA
A Type is made up of other basic variable types which similar with structure in vb.net. The type needs to create in a module otherwise your code won’t be able to reflect it in typing intelligence. The following is and example which I used in one project (the reason i used type because recordcount doesn’t work somehow, it should work after setting recordset.CursorType =adOpenStatic or rs.CursorLocation = adUseClient, but somehow it works only when you using conn.Execute(strSQL) but not run stored procedure by adocommand ):

Public Type EmployeeInfo
    lastname As String
    office As String
    flag As String
End Type

This defines a single type named EmployeeInfo which has three elements. You can then create variables of the Employee type and give values to the elements. For example,

    Dim membersFor() As EmployeeInfo
    Dim conn As ADODB.Connection
    Dim strConn As String
    Dim strSQL As String
    Dim rs As ADODB.Recordset
    Dim totalcount As Integer

    strConn = "Provider=SQLOLEDB.1; Data Source=server\DBInstance;Initial Catalog=db; 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.CommandText = "SpGetLastNameByID"
    cmd.CommandType = adCmdStoredProc
    cmd.Parameters.Refresh
    cmd.Parameters(1).Value = CInt(id)  ' id is an globe variable
    cmd.Parameters(2).Value = 1
    Set rs = cmd.Execute()

    totalcount = 0
    Do While Not rs.EOF
        ReDim Preserve membersFor(totalcount) As EmployeeInfo
        membersFor(totalcount).lastname = RemoveQCInLastName(rs("lastName"))
        membersFor(totalcount).office = RemoveQCInLastName(rs("con"))
        membersFor(totalcount).flag = RemoveQCInLastName(rs("flag"))
        rs.MoveNext
        totalcount = totalcount + 1
    Loop

    Set cmd = Nothing
    conn.Close

Then you can pass the membersFor array as the parameter to the function or procedure, it is simple then using class if you just want to use a light way of object.
However types have a few shortcomings. First, you can’t declare new instances of a Type. You must declare all the variables you’ll need at design time or you need a dynamic array that is resized with Redim Preserve. The second is that you have no control over what values are assigned to the elements of a Type. For example, there is nothing to prevent the assignment of a negative value to the Salary element. Finally, a Type can’t “do” anything, no method allowed, it is simply a static data structure.

2. Class in VBA

First, insert a class module into the VBA project (from the Insert menu in the VBA editor). Name the class as CEmployee (it is common practice to use a ‘C’ as the first letter of a class). There are three properties to create: LastName, Office, and flag. These values will be stored in private variables within the class. Since they are declared Private, they cannot be accessed outside the class module.

Private pLastName As String
Private pOffice As String
Private pFlag As String

Next, declare Property procedures to allow these variables to be read from and written to. It is done with Property Get and Property Set functions (or Property Set for object type variables).

Public Property Get LastName() As String
LastName = pLastName
End Property
Public Property Set LastName(Value As String)
pLastName = Value
End Property

Public Property Get Office() As String
Office = pOffice
End Property
Public Property Set Office(Value As String)
pOffice = Value
End Property

Public Property Get Flag() As Boolean
Flag = pFlag
End Property
Public Property Set Flag(Value As Double)
pSalary = Value
End Property

Because Property procedures can contain any code you like, for example if there is a salary property the set Salary procedure can be written to exclude non-positive values.

Public Property Set Salary(Value As Double)
If Value &gt; 0 Then
pSalary = Value
Else
' appropriate error code here
End If
End Property

A property can be made read-only simply by omitting the Set procedure also can be a calculated one as well.

Property Get WithholdingTax() As Double
WithholdingTax = calculated value
End Property

Finally, the class can contain methods, such as getLastNameByID procedure.

Public Sub getLastNameByID()
' actual code
End Sub

Then it can be used like the following way.

Dim Emp As CEmployee
Set Emp = New CEmployee
Emp.LastName = "TestLastName1"
Emp.Office = "Calgary"
Emp.Flag = true
Emp.Salary = 40000

Word template in startup folder issue and set tab stop position in VBA

As we knew Word 2007’s template file is a dotm file. It allow you to launch a document base on the template. However sometimes we want launch word document which not by clicking the template, for example, just open word and run a macro which we created in the template. In this way, you have to put the template dotm file under C:\Users\username\AppData\Roaming\Microsoft\Word\STARTUP folder, and it will show the macro on any word document.

However when the template drop into the startup folder, the style which referenced in the VBA code doesn’t work because it automatically use normal.dotm’s styles and cannot find the styles in this template. The following code will fail because it cannot find the style name at normal.dotm.

Selection.Style = ActiveDocument.Styles(“style123”)

There are two solutions to solve.
1. use code add a style.


        ActiveDocument.Styles.Add Name:="divisiontable", Type:=wdStyleTypeParagraph
        ActiveDocument.Styles("divisiontable").Font.Name = "Times New Roman"
        ActiveDocument.Styles("divisiontable").Font.Size = 10
        ActiveDocument.Styles("divisiontable").BaseStyle = "Normal"
        ActiveDocument.Styles("divisiontable").NextParagraphStyle = "Normal"
        ActiveDocument.Styles("divisiontable").ParagraphFormat.TabStops.Add Position:= _
        InchesToPoints(1.73), Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
        ActiveDocument.Styles("Styletest").ParagraphFormat.TabStops.Add Position:= _
        InchesToPoints(3.45), Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces

2. Just use the code to generate the paragraph format

   Selection.Font.Name = "Times New Roman"
   Selection.Font.Size = 10
   Selection.ParagraphFormat.TabStops.Add Position:= _
        InchesToPoints(1.73), Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
   Selection.ParagraphFormat.TabStops.Add Position:= _
        InchesToPoints(3.45), Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces

Attachment:

How to create a style in word

1. click the arrow on the right corner

2. Modify or create a new style on the float screen (red rectangle is the “create”)

3. in the following screen setup the format you want

4. click format to setup further, the tab setting also in this menu

5. setup tab stop position