title: Excel code crashes after a couple of uses, opening a connection to Access
body: <p>We have an Excel 2016 quoting tool that uses VBA code to compare the product codes entered against an Access database and then update another sheet with the details needed for our CRM system.<br />
  This is an interim solution until a more permanent one becomes available.</p>
  <p>We can capture 5 quotes, generate the CRM sheet. On the 6th quote when you generate the CRM sheet the following VBA Error shows up.</p>
  <blockquote>
  <p>System Error &amp;H8000FFF (-2147418113)</p>
  </blockquote>
  <p>Fixes I tried, increase the buffer size, clear clipboard. Removing the buffer causes the error almost immediately.</p>
  <p>I found in debugging that the crash will happen at <code>cn.Open</code> as it tries to open a connection to Access.</p>
  <pre class="lang-vb prettyprint-override"><code>Function CRM_Update(PROD As String)
  Application.ScreenUpdating = False
  
      If PROD = &quot;&quot; Then
          emptyline = emptyline + 1
          Exit Function
      Else
          emptyline = 0
      End If
      Set cn = New ADODB.Connection
      cn.ConnectionString = &quot;DSN=MS Access Database;DBQ=C:\database\CRMSA.accdb;DriverId=25;FIL=MS Access;MaxBufferSize=4096;PageTimeout=5;&quot;
      cn.Open
      Set rs = New ADODB.Recordset**
      rs.Open &quot;select * from ARTGROUP WHERE  ART = '&quot; &amp; PROD &amp; &quot;';&quot;, cn, adOpenStatic
      If rs.RecordCount = 0 Then
          MsgBox (PROD &amp; &quot;  &quot; &amp; &quot; not found in article group&quot;)
          Exit Function
      End If
  </code></pre>
  <p>This looks to be related to memory use because you can get further into the generate process if you have very little open but as soon as you have a lot of items open: Chrome, Outlook and other applications you can get maybe 5 generate attempts.<br />
  On a virtual machine with only 4GB of RAM I was able to do this process over 40 times without a single crash.<br />
  On my work laptop with 16GB of RAM and only this open I was able to generate about 16 times before that error comes up.</p>
  <p>Event log:</p>
  <blockquote>
  <p>The system has called a custom component and that component has failed
  and generated an exception. This indicates a problem with the custom
  component. Notify the developer of this component that a failure has
  occurred and provide them with the information below. Component Prog
  ID: SC.Pool 455 1 Method Name: IDispenserDriver::CreateResource
  Process Name: EXCEL.EXE Exception: c0000005 Address: 0X58101018</p>
  </blockquote>
  <p>I removed all custom add-ins and still get this crash. I only have the following MS references in the sheet running namely:</p>
  <p>VB for Applications<br />
  MS Excel 16.0 Object Library<br />
  OLE Automation<br />
  MS Office 16.0 Object Library<br />
  MS Access 16.0 Object Library<br />
  Microsoft ActiveX Data Objects 2.8 Library</p>
  <p>I tried rebuilding the database, compact and repair and decompile but it has no effect.<br />
  I have white listed the database in AV program with no change.</p>
  <p><em>edit</em></p>
  <p>Module 1 is the first VB script that I think opens the Access database.<br />
  Module 2 is VB script that says Cell A in Worksheet A goes to Cell A in Worksheet B, it too is also opening a connection to the Access database but I have not included the formula for the moving part.<br />
  There is a third module that compares the data from the Excel sheet with the Access database and then assigns product codes.</p>
  <p>Module 1:</p>
  <pre class="lang-vb prettyprint-override"><code>Public Function CRM_shortDescr(PROD As String)
  Application.ScreenUpdating = False
      Set cn = New ADODB.Connection
      cn.ConnectionString = &quot;DSN=MS Access Database;DBQ=C:\database\CRMSA.accdb;DriverId=25;FIL=MS Access;MaxBufferSize=4096;PageTimeout=5;&quot;
      '   The database name was set incorrectly here. Changed to correct name.
      cn.Open
      Set rs = New ADODB.Recordset
      rs.Open &quot;select * from ARTGROUP WHERE  ART = '&quot; &amp; PROD &amp; &quot;';&quot;, cn, adOpenStatic
      If rs.RecordCount = 0 Then
          MsgBox (PROD &amp; &quot;  &quot; &amp; &quot; not found in article group&quot;)
          Exit Function
      End If
      PRGR = rs!crm
      rs.Close
      rs.Open &quot;select * from PRGR WHERE  PRGR = '&quot; &amp; Left(PRGR, 2) &amp; &quot;';&quot;, cn, adOpenStatic
      If rs.RecordCount = 0 Then
          MsgBox (PRGR &amp; &quot;  &quot; &amp; &quot; not found in article group&quot;)
          Exit Function
      End If
      CRM_shortDescr = rs!Descr
      rs.Close
  End Function
  </code></pre>
  <p>Module 2 is the one above at the start of this post, missing lines are:</p>
  <pre class="lang-vb prettyprint-override"><code>italyrow = 19 + emptyline
      linenumber = ActiveCell.Row
      linenumbercrm = linenumber - italyrow
  &lt;Formual starts to move from Sheet A to Sheet B but looks like the following
  `Worksheets(&quot;CRM&quot;).Cells(linenumbercrm, 1).Value = Worksheets(&quot;Local Quotation&quot;).Range(&quot;COUNTRY&quot;)&gt;
  rs.Close
  End Function
  </code></pre>