Question

嘿stackoverflow社区，

我正在尝试将特定单元格从Excel工作表导入到ms访问。

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

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

问题是，excel文件非常动态并且发生了变化。因此我在excel中记录了一个宏，用于查找工作表中的特定字段。

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

我将要导入的单元格放入变量“Field”中进行访问。现在我不知道，如何结合这两个代码。

如何在访问中获取变量“Field”？我需要在访问中编码，我从excel导入一个特定的单元格，即在不同地方的每个Excel工作表中？

Answer 1

这可以更轻松地完成。

创建命名范围，保持单元格从中读取数据。

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

修改：

创建命名范围（示例）：

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

将特定单元格从Excel导入MS Access

2 个答案: