Excel VBA使用ADODB，dynamic范围和标题可选，从封闭的工作簿中读取数据

我有一些VBA代码来从工作簿中提取数据与VBA，它的工作原理。 我可以指定input范围，并获取数据。这对我来说很重要，因为我需要能够快速打开一个工作簿（正常打开3分钟，ADODB是12秒…）我因为我只想为自己获取数据，而其他用户正在努力（这里有一些问题）

除了这个代码，它需要能够做到以下几点

• 我需要能够指定数据将去（目标工作表，行和列）
• 我需要能够执行这个macros，而不会干扰其他用户：

如果我运行它的当前窗体中的macros，当另一个用户打开工作簿时，我从中拉取数据，另一个用户无法保存了，有什么build议吗？ 另外：有时当另一个用户打开工作簿时，我无法从中提取数据。

任何人都可以用ADODB打开这个帮助我，其他用户仍然可以保存，并帮助我可以指定目标范围的子？ （所以我可以指定数据将在哪里着陆:)）

非常感谢！

（以下全部代码）

这个子是一个例子，如何提取数据

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 

用ADODB从excel文件中提取数据的子程序

 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 

下面的函数将例如1,1,2,2转换为“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 

下面的函数将例如1,1转换为“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 

下面的函数需要从1到26的任何数字，从字母表中匹配出来的字母：例如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 

下面的函数将ColumnNumber转换为名称（最多3位数字）

 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 

更新我得到或者错误信息“运行时错误”-2147467259（90004005）'：从外部数据库驱动程序（）意外的错误“。 或者使用Excel表格的人在尝试保存时会得到错误信息“无法保存”

Answer 1

不是一个答案，但太大，以适应一个评论….

最后四个方法是这样调用的：

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

可以删除，如果你使用类似的东西：

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