Opening Excel template opens 22+ windows

[VBAPrincess]

Our company is upgrading all user computers to Windows 10 with Office 2016. I have an Access database (mdb) that has code to open an Excel template (xltm), populate data, and then allow the user to save the file. The code worked fine on Windows 7 with Office 2010. Now, when the code opens the template, Excel opens 22 blank windows along with the template. It seems to open as many windows as it can until it finally crashes. I have stepped through the code and it will open the template (line 3), but opens the other windows as soon as the code inserts a value into one of the cells on the worksheet (line 10). The code actually won't let me step through the insertion of the values, but rather just runs to the end once I run that first line that enters data in that first cell.

Any idea what could be happening? I have decompiled/compiled thinking perhaps something was corrupted. It works the same. I tested again using Win7/Ofc2010 just to confirm and it works just fine in that environment.

1     sTemplate = DBPath & "StorageTemplates\StorageFirstRaterv8.xltm"

2     Set oExcel = CreateObject("Excel.Application")
3     Set oWB = oExcel.Workbooks.Open(sTemplate)
4     Set oWS = oWB.Worksheets("Rater")

5     blnOldRate = False

6     sql = "SELECT [Main: Policy].[Policy Increment Key], [Main: Policy].[Name Insured],[Main: Policy].[Policy Number], " & _
            "[Main: Policy].[date effective] AS EffDate, IIf(InStr([status],'renew'),'Renewal','New') AS BizType, " & _
            "[Main: Policy].QuoteDate, Locations.[Building Street], Locations.[Building City], Locations.[Building State], Locations.[Building Zip] " & _
            "FROM [Main: Policy] INNER JOIN Locations ON [Main: Policy].[Policy Increment Key] = Locations.[Policy Increment Key] " & _
            "WHERE ((([Main: Policy].[Policy Increment Key]) = " & lngCodeKey & ")) ORDER BY Locations.LocationID"
7     Set db = CurrentDb
8     Set rs = db.OpenRecordset(sql)

9     If Not rs.EOF Then
10        oWS.Range("E7") = rs.Fields("Name Insured")
11        oWS.Range("E9") = rs.Fields("Policy Number")
12        oWS.Range("E13") = rs.Fields("Building Street")
13        oWS.Range("E15") = rs.Fields("Building City")
14        oWS.Range("E17") = rs.Fields("Building State")
15        oWS.Range("K17") = rs.Fields("Building Zip")
16        oWS.Range("E11") = rs.Fields("EffDate")
17        oWS.Range("K11") = "Bound Policy"
18    End If

Thanks in advance!

Diana

 

[Andrzejek]

Did you try to create a simple, basic Excel file (not a macro-enabled Template) with a worksheet named "Rater" and run your (slightly modified) code:

1     sTemplate = DBPath & "StorageTemplates\[red]SimpleExceFile.xlsx[/red]"

2     Set oExcel = CreateObject("Excel.Application")
3     Set oWB = oExcel.Workbooks.Open(sTemplate)
4     Set oWS = oWB.Worksheets("Rater")

5     blnOldRate = False

6     sql = "SELECT ...
...

---- Andy

There is a great need for a sarcasm font.

 

[SkipVought]

You could run this all from the .xlsm (macro enabled workbook) like this...

Sub GetPolicy()
'SkipVought 2018 AUG 27
'you must set a reference for an appropriate Library
'   Microsoft ActiveX Data Objects n.m Library
    Dim rst As ADODB.Recordset
    Dim cnn As ADODB.Connection
    Dim sPath As String, sDB As String, sConn As String, sSQL As String
    Dim lCodeKey As Long
    
    Set rst = New ADODB.Recordset
    
    Set cnn = New ADODB.Connection
'PATH to your Access DB goes here
    sPath = ""
'your Access DB NAME goes here
    sDB = ""
'connection string goes here | [URL unfurl="true"]www.connectionstrings.com[/URL]
    sConn = ""
    
    sSQL = "SELECT"
    sSQL = sSQL & "  [Main: Policy].[Policy Increment Key]"
    sSQL = sSQL & ", [Main: Policy].[Name Insured]"
    sSQL = sSQL & ", [Main: Policy].[Policy Number]"
    sSQL = sSQL & ", [Main: Policy].[date effective] AS EffDate"
    sSQL = sSQL & ", IIf(InStr([status],'renew'),'Renewal','New') AS BizType"
    sSQL = sSQL & ", [Main: Policy].QuoteDate"
    sSQL = sSQL & ", Locations.[Building Street]"
    sSQL = sSQL & ", Locations.[Building City]"
    sSQL = sSQL & ", Locations.[Building State]"
    sSQL = sSQL & ", Locations.[Building Zip] "
    sSQL = sSQL & vbLf
    sSQL = sSQL & "FROM [Main: Policy] INNER JOIN Locations"
    sSQL = sSQL & "  ON [Main: Policy].[Policy Increment Key] = Locations.[Policy Increment Key] "
    sSQL = sSQL & vbLf
    sSQL = sSQL & "WHERE ((([Main: Policy].[Policy Increment Key]) = " & lCodeKey & ")) "
    sSQL = sSQL & vbLf
    sSQL = sSQL & "ORDER BY Locations.LocationID"
    
    On Error Resume Next
    
    With rst
        .Open sSQL, cnn, adOpenStatic, adLockReadOnly, adCmdText
        
        .MoveFirst
        
        If Err.Number = 0 Then
            Err.Clear
            With ThisWorkbook.Worksheets("Rater")
                .Range("E7") = rs.Fields("Name Insured")
                .Range("E9") = rs.Fields("Policy Number")
                .Range("E13") = rs.Fields("Building Street")
                .Range("E15") = rs.Fields("Building City")
                .Range("E17") = rs.Fields("Building State")
                .Range("K17") = rs.Fields("Building Zip")
                .Range("E11") = rs.Fields("EffDate")
                .Range("K11") = "Bound Policy"
            End With
        Else
            Err.Clear
            MsgBox "No record for " & lCodeKey
        End If
    End With
    
    Set rst = Nothing
    Set cnn = Nothing
End Sub

Note that you must have a reference set for the designated library.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[SkipVought]

Just curious why you have a macro enabled TEMPLATE???



Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[VBAPrincess]

Andy,
Thanks for the suggestion. I tried with a simple xlsx file (I just saved a blank copy of the template which also removed all of the macros from the template) and the same thing occurred. I was really hoping that would solve the issue. The template is not ours but rather it is one provided by the carrier we work with so if that had worked then I could at least appeal to them to solve the issue.

Skip,
The template is not mine and there are multiple worksheets. The macros in the Excel file have to do with rating and calculating premiums based on state and other factors. I have created this code in our Access database in order to make it easier for the department to utilize the carrier's required worksheet. The basic data needed for the worksheet already resides in our database, so we just push the data we have, and then the end users manually complete the rest of the worksheet. I might try adding code into the file to pull the data rather than push, but I'm not sure how my end users will feel about the modified workflow. They are in the database all day so having the process reside here just made more sense.

This is such a strange problem!


Diana

 

[SkipVought]

Are there EVENTS coded in this template? Could it be that some event is kicked off unintentionally?

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Andrzejek]

The way I would approach this issue is: start from the very beginning,
I would create a SimpleFile.xlsx in C:\TEMP\ (not a copy of anything), and try this code from brand new Access:

Dim oExcel As Object
Dim oWB As Object
Dim oWS As Object
Dim sTemplate As String

sTemplate = "C:\TEMP\SimpleFile.xlsx"

Set oExcel = CreateObject("Excel.Application")
Set oWB = oExcel.Workbooks.Open(sTemplate)
Set oWS = oWB.Worksheets("Sheet1")

oExcel.Visible = True

oWS.Range("A1").Value = "Some text"

And if that is successful, I would add to it little by little.
If it is NOT successful, I would guess we have some software installation problems...


---- Andy

There is a great need for a sarcasm font.

 

[VBAPrincess]

Skip,
I've checked all of the worksheets and the only event code is on the Worksheet_Change event for a different worksheet called IM_Rater.

Diana

 

[SkipVought]

How about events in the ThisWorkbook Object?

And what about Andy’s last suggestion of opening/updating a test workbook?

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[VBAPrincess]

No events in the ThisWorkbook object either.

I have another process in the database that populates an xlsx file with data and it works just fine. The only differences between the two processes are the type of Excel file -- xlsx vs xltm -- and one populates data from a recordset while the other just uses data passed to the Access procedure using variables. I've actually got another xltm file from the carrier used for umbrella/excess policies. I tested it and it works just fine.

I'll try to test this afternoon some more.

Diana

 

[Andrzejek]

So it looks like the problem is with the [tt]StorageFirstRaterv8.xltm[/tt] file.
Can you just start this file (not from Access) and it shows up OK?


---- Andy

There is a great need for a sarcasm font.

 

[VBAPrincess]

Yes, when I manually open it I do not encounter errors. I can manually enter data -- the same data the Access code would enter -- and it works just fine. Love it when stuff stops working.

Diana

 

[combo]

Yes, when I manually open it I do not encounter errors. I can manually enter data - the same data the Access code would enter - and it works just fine.

A template is a workbook that excel uses to create new workbook. To properly use it by code, instead [tt]Set oWB = oExcel.Workbooks.Open(sTemplate)[/tt] that just opens the file, use [tt]Set oWB = oExcel.Workbooks.Add(sTemplate)[/tt]. You will get fresh workbook based on your template. You may make excel application visible immediately after you created its instance, at least when testing, so:

2     Set oExcel = CreateObject("Excel.Application")
201   oExcel.Visible = True
3     Set oWB = oExcel.Workbooks.Add(sTemplate)

Usage of template in excel UI: File>New and find the template, can be in "Personal" section.

If possible, can you post the full code in access procedure? It seems that other access code interacts with excel too.

combo

 

[strongm]

And can you just confirm there are no Excel add-ins lurking.

 

[VBAPrincess]

OMG this turned out to be the dumbest thing ever. I moved the oExcel.Visible = True to the beginning of the procedure rather than at the end (where it was so the user wouldn't have to watch the fields getting populated) and the 22 extra windows stopped appearing. WTH?! So, how did I figure it out? I added a break to each line of code that can have a breakpoint because the code kept running once it hit Line 10. (I know, another weird thing -- F8 was useless after that line) Once I had all the breakpoints, I used the immediate window to make Excel = Visible after I created the instance. I was able to run the code slowly and watched for the additional windows to show up. None until Line 60, then boom 22 windows popped up. I commented out Line 60 and added the same code between Line 2 and 3. Took out all the breakpoints and it ran smoothly like it did previously on Windows 7 and Office 2010. UGGGHHH. Guess my users will have to see the worksheet get populated. Not a big deal and they'll just be happy this is working again. Hope this helps someone else!

Public Sub CreateAIXPropGL(ByVal lngCodeKey As Long)
      Dim oExcel As Excel.Application
      Dim oWB As Excel.Workbook
      Dim oWS As Excel.Worksheet
      Dim oRange As Excel.Range
      Dim sTemplate As String
      Dim db As DAO.Database
      Dim rs As DAO.Recordset
      Dim sql As String
      Dim blnOldRate As Boolean

    On Error GoTo CreateAIXPropGL_Error

1     sTemplate = DBPath & "StorageTemplates\StorageFirstRaterv8.xltm"

2     Set oExcel = CreateObject("Excel.Application")
oExcel.Visible = True '<<< ADDED CODE HERE INSTEAD OF LINE 60
3     Set oWB = oExcel.Workbooks.Add(sTemplate)
4     Set oWS = oWB.Worksheets("Rater")

5     blnOldRate = False

6     sql = "SELECT [Main: Policy].[Policy Increment Key], [Main: Policy].[Name Insured],[Main: Policy].[Policy Number], " & _
            "[Main: Policy].[date effective] AS EffDate, IIf(InStr([status],'renew'),'Renewal','New') AS BizType, " & _
            "[Main: Policy].QuoteDate, Locations.[Building Street], Locations.[Building City], Locations.[Building State], Locations.[Building Zip] " & _
            "FROM [Main: Policy] INNER JOIN Locations ON [Main: Policy].[Policy Increment Key] = Locations.[Policy Increment Key] " & _
            "WHERE ((([Main: Policy].[Policy Increment Key]) = " & lngCodeKey & ")) ORDER BY Locations.LocationID"
7     Set db = CurrentDb
8     Set rs = db.OpenRecordset(sql)

9     If Not rs.EOF Then
10        oWS.Range("insured_name") = rs.Fields("Name Insured")
11        oWS.Range("E9") = rs.Fields("Policy Number")
12        oWS.Range("E13") = rs.Fields("Building Street")
13        oWS.Range("E15") = rs.Fields("Building City")
14        oWS.Range("E17") = rs.Fields("Building State")
15        oWS.Range("K17") = rs.Fields("Building Zip")
16        oWS.Range("E11") = rs.Fields("EffDate")
17        oWS.Range("K11") = "Bound Policy"
18    End If

19    rs.Close

      ''''''''''''''''''''''''''''''
      ''' 1/27/2016
      ''' get BaseRate from QuoteFactors
20    sql = "SELECT QuoteFactors.BaseRate FROM QuoteFactors WHERE QuoteFactors.[CodeKey]=" & lngCodeKey
21    Set rs = db.OpenRecordset(sql)

22    If Not rs.EOF Then
23        oWS.Range("K53") = rs.Fields("BaseRate")
24    Else
          'BaseRate not populated so get the rate from Buildings table
25        blnOldRate = True
26    End If
27    rs.Close
      ''''''''''''''''''''''''''''''

      'GL AND HNO
28    sql = "SELECT Buildings.[Policy Increment Key], Buildings.Coverage, Buildings.Value, Buildings.Rate, Buildings.Premium, " & _
            "Buildings.BIValue, Coverages.Type FROM Buildings INNER JOIN Coverages ON Buildings.Coverage = Coverages.Coverage " & _
            "WHERE (((Buildings.[Policy Increment Key])=" & lngCodeKey & ") AND ((Coverages.Type) IN ('GL','HNO')));"
29    Set rs = db.OpenRecordset(sql)

30    If Not rs.EOF Then
31        If blnOldRate Then
32            oWS.Range("K53") = rs.Fields("Rate")
33        End If
34        oWS.Range("E53") = rs.Fields("BIValue")
35    End If

      Dim strMinPrem As String, strCvg As String
      Dim curMinPrem As Currency
36    strMinPrem = ""

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''    1/11/2016: do not check the coverage boxes
'37    Do Until rs.EOF
'38        If InStr(rs.Fields("Coverage"), "Goods") > 0 Then
'      '38            oWS.CheckBoxes("Check Box 4").Value = True
'39            strCvg = "CGLL"
'40        ElseIf InStr(rs.Fields("Coverage"), "Disposal") > 0 Then
'      '40            oWS.CheckBoxes("Check Box 6").Value = True
'41            strCvg = "S&DL"
'42        ElseIf InStr(rs.Fields("Coverage"), "Manager") > 0 Then
'      '42            oWS.CheckBoxes("Check Box 103").Value = True
'43            strCvg = "RML"
'44        ElseIf InStr(rs.Fields("Coverage"), "Commercial") > 0 Then
'45            strCvg = "GL"
'46        Else
'47            GoTo NextCvg
'48        End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
          
37    Do Until rs.EOF
          'check for minimum premium
49        curMinPrem = Nz(ELookup("MinPremium", "Coverages", "Coverage='" & rs.Fields("Coverage") & "'"), 0)
50        If curMinPrem = rs.Fields("Premium") Then
51            strMinPrem = strMinPrem & "Minimum Premium " & strCvg & " $" & curMinPrem & " | "
52        End If
        
NextCvg:
53        rs.MoveNext
54    Loop

55    If strMinPrem <> "" Then
56        oWS.Range("E24") = Left(strMinPrem, Len(strMinPrem) - 2)
57        oWS.Range("K53") = Null
58    End If
59    rs.Close

'60    oExcel.Visible = True <<< THIS LINE RIGHT HERE

Exit_CreateAIXPropGL:
    Set rs = Nothing
    Set db = Nothing
    Set oRange = Nothing
    Set oWS = Nothing
    Set oWB = Nothing
    Set oExcel = Nothing
    Exit Sub

CreateAIXPropGL_Error:
    Call LogError(Err.Number, Err.Description, "basExportItem.CreateAIXPropGL", Erl)
    Resume Exit_CreateAIXPropGL
End Sub

Diana

 

[SkipVought]

Great!!

You might want to use ScreenUpdating...

Public Sub CreateAIXPropGL(ByVal lngCodeKey As Long) 
‘....you declarations
   Application.ScreenUpdating = FALSE
‘....all your executable code
   Application.ScreenUpdating = TRUE
   Exit

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Andrzejek]

And I would be very tempted to use some Aliases for your tables in the SQL to make the statement shorter, something like:

sql = "SELECT MP.[Policy Increment Key], MP.[Name Insured],MP.[Policy Number], " & _
    "MP.[date effective] AS EffDate, IIf(InStr([status],'renew'),'Renewal','New') AS BizType, " & _
    "MP.QuoteDate, L.[Building Street], L.[Building City], L.[Building State], L.[Building Zip] " & _
    "FROM [Main: Policy] MP INNER JOIN Locations L ON MP.[Policy Increment Key] = L.[Policy Increment Key] " & _
    "WHERE (((MP.[Policy Increment Key]) = " & lngCodeKey & ")) ORDER BY L.LocationID"

---- Andy

There is a great need for a sarcasm font.