从Excel导入特定的单元格到MS Access

嘿stackoverflow社区，

我试图从Excel表导入一个特定的单元格到MS访问。

我已经在Access中创build了一个代码，它将excel中的特定字段放在访问表中。

Const fName As String = "C:\Users\...\" & varP_ID & ".xlsb" DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "ImportData", _ fName, False, "Project Details!H12:H12" 

问题是，Excel文件是非常dynamic和变化的。 正因为如此，我在excel中logging了一个macros查找表中的特定字段。

 Dim Field As String Cells.Find(What:="goal", After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ False, SearchFormat:=False).Activate Selection.End(xlDown).Select Field = Selection.Text 

我把我要导入的单元格放在variables“Field”中。 现在我不知道，如何把这两个代码结合起来。

我如何获得访问variables“字段”？ 我必须在访问代码，我从Excel中导入一个特定的单元格，这是在每个Excel表格在不同的地方？

Answer 1

这可以做得更容易。

创build一个名称范围，持有单元格从中读取数据。

然后在调用TransferSpreadsheet时指定命名范围。

编辑 ：

创build命名范围（示例）：

 Range("A1").Select Cells.Find(What:="goal", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False).Activate ActiveCell.Offset(1,5).Resize(1,60).Select ActiveWorkbook.Names.Add Name:="Lots", RefersTo:=Selection 

Answer 2

有很多方法可以做到这一点。

 Sub ImportDataFromRange() ' Assign the Excel Object Dim excelapp As Object Set excelapp = CreateObject("excel.application") ' Assign the workbook Dim wb As Object Set wb = excelapp.Workbooks.Open("C:\your_path\Excel.xls") ' Assign the result of your CountA function used in the next line Dim numberofrows As Integer ' Get the bottom-most row number needed to complete our dynamic range address numberofrows = 2 + excelapp.Application.CountA(wb.worksheets("Dynamic").Range("A1:A10")) ' Delete any previous access table, otherwise the next line will add an additional table each time it is run DoCmd.DeleteObject acTable, "ExcelDynamicRangeData" ' Import data from Excel using a range that now knows where bottom row number is DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel9, "ExcelDynamicRangeData", "C:\your_path\Excel.xls", True, "Dynamic!A1:B" & numberofrows ' Close and clean wb.Close Set wb = Nothing excelapp.Quit Set excelapp = Nothing End Sub Private Sub Command0_Click() ImportDataFromRange End Sub 

还有 。 。

 Sub ADOFromExcelToAccess() ' exports data from the active worksheet to a table in an Access database ' this procedure must be edited before use Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long ' connect to the Access database Set cn = New ADODB.Connection cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _ "Data Source=C:\FolderName\DataBaseName.mdb;" ' open a recordset Set rs = New ADODB.Recordset rs.Open "TableName", cn, adOpenKeyset, adLockOptimistic, adCmdTable ' all records in a table r = 3 ' the start row in the worksheet Do While Len(Range("A" & r).Formula) > 0 ' repeat until first empty cell in column A With rs .AddNew ' create a new record ' add values to each field in the record .Fields("FieldName1") = Range("A" & r).Value .Fields("FieldName2") = Range("B" & r).Value .Fields("FieldNameN") = Range("C" & r).Value ' add more fields if necessary... .Update ' stores the new record End With r = r + 1 ' next row Loop rs.Close Set rs = Nothing cn.Close Set cn = Nothing End Sub