1
votes

When I make a call to open a connection to another workbook, occasionally the workbook will open fully in Excel. I have ~15 data sets I pull using this method and I have not been able to identify a pattern. yesterday the refresh was quick and seamless and no workbooks visibly opened in Excel. Today 1 of 2 is opening in Excel.

Since I have users of varying experience with Excel, I would like to eliminate this possibly confusing behavior.

oCnC.Open "Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Data Source=" & Filename & ";Extended Properties=""Excel 12.0; HDR=YES;"";"

Example code:

sub Caller
    Set dTabs = New Dictionary
    Set dTabs("Cerner") = New Dictionary
        dTabs("Cerner")("Query") = "Select Field1, Field2 from [Sheet1$]"
        dTabs("Cerner")("Hidden") = 1
    Call GetMasterTables("\\\Files\File1.xlsx", dTabs)
    dTabs.RemoveAll

    Set dTabs = New Dictionary
    Set dTabs("SER") = New Dictionary
        dTabs("SER")("Query") = "Select [1],F75 from [Sheet1$]"
        dTabs("SER")("Hidden") = 1
    Call GetMasterTables("\\Files\File2.xlsx", dTabs)
    dTabs.RemoveAll
    (Cleanup)
End Sub

Private Sub GetMasterTables(Filename As String, dTabset As Dictionary, ByRef wb As Workbook)
    Dim oCnC As Connection
    Dim rsC As Recordset
    Dim rsE As Recordset
    Dim lo As ListObject
    Dim rngHome As Range

    Set oCnC = New Connection
    Set rsC = New Recordset
    Set rsE = New Recordset
    Dim ws As Worksheet

    oCnC.Open "Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Data Source=" & Filename & ";" & _
              "Extended Properties=""Excel 12.0; HDR=YES;"";"
    rsC.ActiveConnection = oCnC

    For Each i In dTabset
        If SheetExists(i, wb) Then
            Set ws = wb.Sheets(i)
            ws.Visible = xlSheetVisible
        Else
            Set ws = wb.Sheets.Add(, wb.Sheets(wb.Sheets.count))
            ws.Name = i
            ws.Visible = xlSheetVisible
        End If
        Set rngHome = ws.Range("A1")
        If RangeExists("Table_" & Replace(i, "-", "_"), ws) Then
            Set lo = ws.ListObjects("Table_" & Replace(i, "-", "_"))
            lo.DataBodyRange.Delete
        Else
            Set lo = ws.ListObjects.Add(, , , xlYes, rngHome)
            lo.Name = "Table_" & Replace(i, "-", "_")
            lo.DisplayName = "Table_" & Replace(i, "-", "_")

        End If
        If dTabset(i).Exists("Query") Then
            rsC.Source = dTabset(i)("Query")
        Else
            rsC.Source = "Select * from [" & i & "$]"
        End If
        rsC.Open
        rsC.MoveFirst
        ws.Range(lo.HeaderRowRange.Offset(1, 0).address).Value = "hi"
        lo.DataBodyRange.CopyFromRecordset rsC
        rsC.MoveFirst
        For Each j In lo.HeaderRowRange.Cells
            j.Value = rsC.Fields(j.Column - 1).Name
        Next j
        rsC.Close
        If dTabset(i).Exists("Hidden") Then
            ws.Visible = xlSheetHidden
        Else
            ws.Visible = xlSheetVisible
        End If
    Next i
End Sub

 Function SheetExists(ByVal shtName As String, Optional wb As Workbook) As Boolean
     Dim sht As Worksheet

     If wb Is Nothing Then Set wb = ActiveWorkbook
     On Error Resume Next
     Set sht = wb.Sheets(shtName)
     On Error GoTo 0
     SheetExists = Not sht Is Nothing
 End Function

 Function RangeExists(ByVal rngName As String, Optional ws As Worksheet) As Boolean
     Dim rng As ListObject

     If ws Is Nothing Then Set ws = ActiveWorksheet
     On Error Resume Next
     Set rng = ws.ListObjects(rngName)
     On Error GoTo 0
     RangeExists = Not rng Is Nothing
 End Function

Update 1

Ah-ha! I have an update.

After the last test I had left the workbook open. When I came back to the computer after a few minutes there was a prompt up that the file was available for editing. Perhaps the intermittent behavior is due to the requested file being open by another user. I tested this theory by closing the workbook and then re-running the sub and it did not open the file in the app.

Update 2 Qualified my sheets references. Issue is still happening.

2
Adding those does not keep the workbook from opening. It just keeps the user from seeing it opening until after the code has run. - ghangas
Your update seems to be related to an issue I am having, where a query can only access ranges extending beyond row 65536 if I have the workbook opened as read-only AND no other user has it open. If either of those two conditions aren't satisfied it tells me that the range doesn't exist. But I think the answer Comintern just posted will solve your problem. (My problem is probably going to require a Microsoft solution. :( ) - YowE3K
@YowE3K - I am not exceeding 65535 rows. I am pulling 55000 or less in both queries. - ghangas
Sorry - I didn't mean that you were accessing beyond row 65536 (it's not the number of rows in the range, it's the location of the range) - just that your problem is linked to whether or not another user (or yourself) is using the queried workbook at the same time and ADO exhibiting different behaviour if they are. - YowE3K
Oh, yeah. Now I am tracking with you. I thought that might be it, so I have been scouring options in connections strings to try to force the behavior I am looking for. No luck so far. - ghangas

2 Answers

0
votes

The issue is here (and anywhere else you're using Sheets without an object reference):

Set ws = Sheets(i)
ws.Visible = xlSheetVisible

Sheets is a global collection of the Application, not the Workbook that the code is running from. Track down all of these unqualified references and make them explicit:

Set ws = ThisWorkbook.Sheets(i)

You should also pass your optional parameter here:

'SheetExists(i)
'...should be...
SheetExists(i, ThisWorkbook)

I'm guessing the reason this is intermittent is that you're catching instances where the ADO connection has the other Workbook active, and your references aren't pointing to where they're supposed to.

0
votes

In addition to the code review offered by @Comintern and @YowE3K I found a solution in the following:

  1. Qualify my workbooks, and my sheets
  2. Turn off screen updating (so the users can't see my magic)
  3. Throw the book names in a dictionary before I do my update and close any extras that opened during the update.

    Application.ScreenUpdating = False
    For i = 1 To Application.Workbooks.count
    Set dBooks(Application.Workbooks(i).Name) = i
    Next i
    Application.ScreenUpdating = False
    

Code from question

    For i = 1 To Application.Workbooks.count
        If dBooks.Exists(Application.Workbooks(i).Name) Then
            dBooks.Remove (Application.Workbooks(i).Name)
        Else
            dBooks(Application.Workbooks(i).Name) = i
        End If
    Next i
    For Each bookname In dBooks
        Application.Workbooks(bookname).Close (False)
    Next
    Application.ScreenUpdating = True