bb_
bb_

Reputation: 1

Excel VBA read data from closed workbook with ADODB, Dynamic Range & header optional

I have some VBA code to pull out data from a workbook with VBA, and it works. I can specify the input range, and get the data in. This is important for me because i need to be able to open a workbook fast (normal opening is 3+ minutes, ADODB is 12 seconds...) Also it is important for me since i want to just get the data for myself, while other users are working on it (and here comes some problem in)

In addition to this code, it needs to be able to do the following

If i run the macro in it's current form, When another user has the workbook open, i pull data from it, the other user is not able to save anymore, any suggestions? Also: Sometimes when another user has the workbook open, I am not able to pull data from it.

Anybody can help me out with being able to open this with ADODB and other users can still save, and helping me with being able to specify the destination range in the sub? (so i can specify where the data will land ? :) )

Many thanks!

(Below all Code)

This sub is an example sub, of how to pull out the data

Sub test()

    file_path = "C:\"
    file_name = "Example.xlsx"

    Call Pull_Data_from_Excel_with_ADODB(CStr(file_path & file_name), "The Worksheet", 1, 1, 600, 25)
End Sub

The sub that pulls data from an excel file with ADODB

Sub Pull_Data_from_Excel_with_ADODB(filename As String, sheetname As String, _
                                    startRow As Integer, StartColumn As Integer, _
                                    endRow As Integer, EndColumn As Integer)

'-----------------------------------------------------------------------------------
'I ********references are set to:********
'I * Visual Basic For Applications
'I * Microsoft Excel 12.0 ObjectLibrary
'I * Microsoft ADO Ext. 6.0 for DDL and Security
'I * Microsoft ActiveX Data Objects 6.1 Library
'I * Microsoft AcitveX Data Objects Recordset 6.0 Library
'-----------------------------------------------------------------------------------


On Error Resume Next
    Dim cnStr As String
    Dim rs As ADODB.Recordset
    Dim query As String
    Application.ScreenUpdating = False
    my_range = CellRange_to_nameRange(startRow, StartColumn, endRow, EndColumn)
    sheetrange = my_range
    'Dim filename As String
    'filename = "C:\temp\file1.xlsm"

    cnStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
               "Data Source=" & filename & ";" & _
               "Extended Properties=Excel 12.0"

    'query = "SELECT * FROM [Sheet1$D1:D15]"
    query = "SELECT * FROM [" & sheetname & "$" & sheetrange & "]"

    Set rs = New ADODB.Recordset
    rs.Open query, cnStr, adOpenStatic, adLockReadOnly


    '------------------------------------------------------------------------'------------------------------------------------------------------------
    '   Ways of opening the data & their explaination - CursorTypeEnum Values
    '------------------------------------------------------------------------'------------------------------------------------------------------------
    '   Constant        -   Value   -   Description
    '------------------------------------------------------------------------'------------------------------------------------------------------------
    '   adOpenUnspecified   -   -1  -   Unspecified type of cursor
    '   adOpenForwardOnly   -   0   -   Default. A forward-only cursor. This improves performance when you need to make only one pass through a Recordset
    '   adOpenKeyset        -   1   -   A keyset cursor. Like a dynamic cursor, except that you can't see records that other users add, although records that other users delete are inaccessible from your Recordset. Data changes by other users are still visible.
    '   adOpenDynamic       -   2   -   A dynamic cursor. Additions, changes, and deletions by other users are visible, and all types of movement through the Recordset are allowed
    '   adOpenStatic        -   3   -   A static cursor. A static copy of a set of records that you can use to find data or generate reports. Additions, changes, or deletions by other users are not visible.
    '------------------------------------------------------------------------'------------------------------------------------------------------------


    '------------------------------------------------------------------------'------------------------------------------------------------------------
    '   Lock Types & their explaination - LockTypeEnum Values
    '------------------------------------------------------------------------'------------------------------------------------------------------------
    '   Constant            -   Value   -   Description
    '------------------------------------------------------------------------'------------------------------------------------------------------------
    '   adLockUnspecified       -   -1  -   Unspecified type of lock. Clones inherits lock type from the original Recordset.
    '   adLockReadOnly          -   1   -   Read-only records
    '   adLockPessimistic       -   2   -   Pessimistic locking, record by record. The provider lock records immediately after editing
    '   adLockOptimistic        -   3   -   Optimistic locking, record by record. The provider lock records only when calling update
    '   adLockBatchOptimistic   -   4   -   Optimistic batch updates. Required for batch update mode
    '------------------------------------------------------------------------'------------------------------------------------------------------------


    '------------------------------------------------------------------------'------------------------------------------------------------------------
    '   ????????? - CommandTypeEnum Values
    '------------------------------------------------------------------------'------------------------------------------------------------------------
    '   Constant            -   Value   -   Description
    '------------------------------------------------------------------------'------------------------------------------------------------------------
    '   Constant            -   Value   -   Description
    '   adCmdUnspecified    -   -1      -   Unspecified type of command
    '   adCmdText           -   1       -   Evaluates CommandText as a textual definition of a command or stored procedure call
    '   adCmdTable          -   2       -   Evaluates CommandText as a table name whose columns are returned by an SQL query
    '   adCmdStoredProc     -   4       -   Evaluates CommandText as a stored procedure name
    '   adCmdUnknown        -   8       -   Default. Unknown type of command
    '   adCmdFile           -   256     -   Evaluates CommandText as the file name of a persistently stored Recordset. Used with Recordset.Open or Requery only.
    '------------------------------------------------------------------------'------------------------------------------------------------------------

    '------------------------------------------------------------------------'------------------------------------------------------------------------
    '   Some Extra Options, i guess - ExecuteOptionEnum Values
    '------------------------------------------------------------------------'------------------------------------------------------------------------
    '   Constant                -   Value   -   Description
    '------------------------------------------------------------------------'------------------------------------------------------------------------
    '   adOptionUnspecified     -   -1      -   Unspecified command
    '   adAsyncExecute          -   16      -   The command should execute asynchronously. Cannot be combined with the CommandTypeEnum value adCmdTableDirect
    '   adAsyncFetch            -   32      -   The remaining rows after the initial quantity specified in the CacheSize property should be retrieved asynchronously
    '   adAsyncFetchNonBlocking -   64      -   The main thread never blocks while retrieving. If the requested row has not been retrieved, the current row automatically moves to the end of the file. If you open a Recordset from a Stream containing a persistently stored Recordset, adAsyncFetchNonBlocking will not have an effect; the operation will be synchronous and blocking. adAsynchFetchNonBlocking has no effect when the adCmdTableDirect option is used to open the Recordset
    '   adExecuteNoRecords      -   128     -   The command text is a command or stored procedure that does not return rows. If any rows are retrieved, they are discarded and not returned. adExecuteNoRecords can only be passed as an optional parameter to the Command or Connection Execute method
    '   adExecuteStream         -   256     -   The results of a command execution should be returned as a stream. adExecuteStream can only be passed as an optional parameter to the Command Execute method
    '   adExecuteRecord         -   512     -   The CommandText is a command or stored procedure that returns a single row which should be returned as a Record object
    '------------------------------------------------------------------------'------------------------------------------------------------------------

    Cells.Clear
    Range("A3").CopyFromRecordset rs
    Dim cell As Range, i As Long
    'headers

    With Range("A1").CurrentRegion
        For i = 0 To rs.Fields.Count - 1
            .Cells(2, i + 1).Value = rs.Fields(i).Name
        Next i
        .EntireColumn.AutoFit
    End With
    rs.Close
    'Unload rs
    Application.ScreenUpdating = True
End Sub

Function below converts e.g. 1,1,2,2 to "A1:B2"

Public Function CellRange_to_nameRange(startRow As Integer, StartColumn As Integer, endRow As Integer, EndColumn As Integer)
Dim exportstring As String
exportstring = CStr(RowAndCollumnToName(startRow, StartColumn)) + ":" + CStr(RowAndCollumnToName(endRow, EndColumn))
CellRange_to_nameRange = exportstring
End Function

Function below converts e.g.: 1,1, to "A1"

Public Function RowAndCollumnToName(row_number As Integer, column_number As Integer)
Dim constr As String
constr = CStr(ColumnNumber_to_ColumnName(CInt(column_number)))
constr = constr & CStr(row_number)
RowAndCollumnToName = constr
End Function

Function below takes in any number from 1 to 26, an spits out the matching letter from the alphabet: e.g. 3 --> C

Public Function number_to_alphabet_letter(number As Integer)

Dim MyArray(1 To 26) As String

    For intLoop = 1 To 26
        MyArray(intLoop) = Chr$(64 + intLoop)
    Next


    number_to_alphabet_letter = MyArray(number)
End Function

And function below converts the ColumnNumber to the name (up to 3 digits...)

Public Function ColumnNumber_to_ColumnName(number As Integer)
On Error Resume Next

Dim first_digit As Integer
Dim first_letter As String

first_digit = number Mod 26
first_letter = number_to_alphabet_letter(first_digit)
'-----------------------------------------------------------
Dim second_digit As Integer
Dim second_letter As String

second_digit = (((number - (number Mod 26)) / 26) Mod 26)
second_letter = number_to_alphabet_letter(second_digit)
'-----------------------------------------------------------
Dim third_digit As Integer
Dim third_letter As String

third_digit = number - ((((number Mod 26) + ((((number - (number Mod 26)) / 26) Mod 26) * 26))))
third_digit = third_digit / (26 * 26)
third_letter = number_to_alphabet_letter(third_digit)
'-----------------------------------------------------------
'number_to_alphabet_letter_advanced = CStr(third_digit) + "-" + CStr(second_digit) + "-" + CStr(first_digit) 'test
ColumnNumber_to_ColumnName = third_letter + second_letter + first_letter
End Function

update i get eitherway or the error message "Run-time error '-2147467259 (90004005)': Unexpected error from external database driver ()." or the person that uses the excel sheet gets the error message "can't save" when trying to save

Upvotes: 0

Views: 7895

Answers (1)

Tim Williams
Tim Williams

Reputation: 166381

Not an answer, but too large to fit in a comment....

Those last four methods called by this:

my_range = CellRange_to_nameRange(startRow, StartColumn, endRow, EndColumn) 

can be removed if you instead use something like:

With ActiveSheet
    my_range = .Range(.Cells(startRow, StartColumn), _
                      .Cells(endRow, EndColumn)).Address()
End With

Upvotes: 1

Related Questions