Run time error 7867: database already open

[The_Kurgan]

Good day!
I'm running an automation process by which I open Access via Excel, run a macro, then return the data to Excel. This works fine on my computer, but my coworker gets this error when running it on his: "You already have the database open." The db is not open, however. I don't believe this to be a reference issue, as we are both using the same Excel workbook... references will be the same for both of us.

Thoughts/suggestions would be welcome. Thank you in advance!

 

[BrianMH]

Are you using transferspreadsheet to export the data to excel? If so does someone have the excel workbook you are exporting to open at the time?

 

[Norie]

What does the macro do?

 

[The_Kurgan]

Nope. It doesn't even get that far.

Here is part of my code:

'run macros
For iter = 1 To bottom_row - 1
If IsEmpty(MyMacro(iter)) = False Then
   Set AccessApp = CreateObject("Access.Application")
   With AccessApp
      [COLOR=#ff0000].OpenCurrentDatabase MyAccessPath(iter)
[/COLOR]     .Visible = False
      .DoCmd.RunMacro MyMacro(iter)
      .CloseCurrentDatabase
      .Quit
   End With
   Application.StatusBar = "Running macro: " & MyMacro(iter) & "... "
End If
Next iter

It hangs while trying to execute the red line.

 

[The_Kurgan]

The macro runs some code (all code, no query) which creates a table. But it doesn't even get that far because it pukes trying to open the database.

 

[Norie]

Have you tried creating the table using ADO/DAO?

Then you wouldn't need to open the database.

 

[The_Kurgan]

I have not. Unfortunately, I don't believe I would know how.

 

[Norie]

It shouldn't be too difficult but you might be somewhat restricted in what you can do when creating the table, eg you won't be able to set formats/rules for fields.

How complicated is the table you are creating?

 

[The_Kurgan]

It's a bit much. Below is the code.

Function Run_Fundings_Routine()
Dim DB As DAO.Database
Dim RS As DAO.Recordset
Dim RS2 As DAO.Recordset
Dim RS3 As DAO.Recordset
Dim SQL As String
Dim SQL2 As String
Dim SQL3 As String
Set DB = CurrentDb()
'Delete old Notice_Temp table
DoCmd.SetWarnings False
SQL = "DELETE * " & _
      "FROM Notice_Temp "
DoCmd.RunSQL (SQL)
'Find last run date
SQL = "SELECT TOP 1 Run_Days.Run_Date " & _
      "FROM Run_Days " & _
      "ORDER BY Run_Days.Run_Date DESC;"
Set RS = DB.OpenRecordset(SQL)
RS.MoveFirst
Last_Update = RS![Run_Date]
RS.Close
'Days since last run
Days_Since_Last_Run = Date - Last_Update
'Go through large secondary table to find fundings >= 30 days

SQL = "SELECT dbo_vw_SecondaryMarketing_AllLoans.[Loan Number], dbo_vw_SecondaryMarketing_AllLoans.[Borrower Last Name], dbo_vw_SecondaryMarketing_AllLoans.Branch, dbo_vw_SecondaryMarketing_AllLoans.LoanFolder, dbo_vw_SecondaryMarketing_AllLoans.[Funding Funds Sent Date], dbo_vw_SecondaryMarketing_AllLoans.Investor, Date()-[Funding Funds Sent Date] AS Funding_Maturity " & _
      "FROM dbo_vw_SecondaryMarketing_AllLoans " & _
      "WHERE (((dbo_vw_SecondaryMarketing_AllLoans.LoanFolder) Not Like '*Test*' And " & _
      "(dbo_vw_SecondaryMarketing_AllLoans.LoanFolder) Not Like '*Train*' And (dbo_vw_SecondaryMarketing_AllLoans.LoanFolder) Not Like '*Trash*') AND ((dbo_vw_SecondaryMarketing_AllLoans.[Funding Funds Sent Date]) Is Not Null) AND ((dbo_vw_SecondaryMarketing_AllLoans.Investor) Not Like '*Housing*' And (dbo_vw_SecondaryMarketing_AllLoans.Investor)<>'WHEDA' And (dbo_vw_SecondaryMarketing_AllLoans.Investor) Not Like 'U.S*' And (dbo_vw_SecondaryMarketing_AllLoans.Investor) Not Like 'TDHC*' And (dbo_vw_SecondaryMarketing_AllLoans.Investor) Not Like 'PIMA*' And (dbo_vw_SecondaryMarketing_AllLoans.Investor)<>'NCHFA' And (dbo_vw_SecondaryMarketing_AllLoans.Investor)<>'Portfolio' And (dbo_vw_SecondaryMarketing_AllLoans.Investor)<>'*FIMC' And (dbo_vw_SecondaryMarketing_AllLoans.Investor)<>'Fairway Independent Mortgage Corporation') AND ((Date()-[Funding Funds Sent Date])>=30) AND ((dbo_vw_SecondaryMarketing_AllLoans.[Purchase Advice Date]) Is Null)) " & _
      "ORDER BY Date()-[Funding Funds Sent Date] DESC;"
Set RS = DB.OpenRecordset(SQL)
RS.MoveFirst
Do Until RS.EOF = True
    MyLoan = RS![Loan Number]
    Fund_Mat = RS![Funding_Maturity]
    Branch = RS![Branch]
    Investor = RS![Investor]
    Last_Name = RS![Borrower Last Name]
    
    'see if the number of days since funded will warrant a notice
    'For iter = Days_Since_Last_Run - 1 To 0 Step -1
    For iter = 0 To Days_Since_Last_Run - 1
        SQL2 = "SELECT Notice_Days.Notice_Days " & _
               "FROM Notice_Days " & _
               "WHERE Notice_Days.Notice_Days =" & Fund_Mat - iter & ";"
        Set RS2 = DB.OpenRecordset(SQL2)
        If RS2.RecordCount <> 0 Then
             'It warrants a notice.  Now see if record for this loan exists in Notice_Tracking.
             SQL3 = "SELECT Notice_Tracking.Loan, Notice_Tracking.Branch, Notice_Tracking.[Last_notice_sent_for_(days)], Notice_Tracking.Date_Last_Notice " & _
                     "FROM Notice_Tracking " & _
                     "WHERE (((Notice_Tracking.Loan)='" & MyLoan & "'));"
             Set RS3 = DB.OpenRecordset(SQL3)
             'Record exists in Notice_Tracking, so update info
             If RS3.RecordCount <> 0 Then
                 RS3.Edit
                 RS3![Last_notice_sent_for_(days)] = Fund_Mat - iter
                 RS3![Date_Last_Notice] = Date
                 RS3.Update
             'Record does not exist in Notice_Tracking, so add info
             Else
                 SQL2 = "INSERT INTO Notice_Tracking ( Loan, Borrower_Last_Name, Branch, Investor, [Last_notice_sent_for_(days)], Date_Last_Notice ) " & _
                        "SELECT " & MyLoan & ", '" & Replace(Last_Name, "'", "''") & "', " & Branch & ", '" & Replace(Investor, "'", "''") & "', " & Fund_Mat - iter & ", #" & Date & "#;"
                 DoCmd.RunSQL (SQL2)
             End If
             'Add info to Notice_Temp
             SQL2 = "INSERT INTO Notice_Temp ( Loan, Borrower_Last_Name, Branch, Investor, Days ) " & _
                    "SELECT " & MyLoan & ", '" & Replace(Last_Name, "'", "''") & "', " & Branch & ", '" & Replace(Investor, "'", "''") & "', " & Fund_Mat - iter & ";"
             DoCmd.RunSQL (SQL2)
             RS2.Close
             RS3.Close
            
            GoTo Next_Loan_Plz
        End If
    Next iter
    
    
    
Next_Loan_Plz:
    RS.MoveNext
Loop
'update last_run date
SQL3 = "INSERT INTO Run_Days ( Run_Date ) " & _
       "SELECT #" & Date & "# AS Run_Date;"
DoCmd.RunSQL (SQL3)
DoCmd.SetWarnings True
RS.Close
End Function

 

[The_Kurgan]

I'm still at a loss as to why he is getting that error and I'm not though. If I could figure that out, it would make life a lot easier.