Question

我每天都有多个excel文件发送给我。每个都是相同的，包含建筑工头的日志。在这些excel表上，我有一张表，工头每天都会用他们的新信息更新。我希望能够在访问中汇集这些表中的所有数据，并使用访问报告功能为工头组创建每日报告。

如果没有更好的方法，我怎样才能将这些信息从多个电子表格导入或导出到一个访问表中？

如果这也可以由工头远程地在SQL服务器中完成，这也是很好的。

编辑：我面临的特殊困难是访问只允许我选择表格所在的表格，而不是表格本身。除了表格外，该表格还有更多信息。有没有办法在导入时选择特定的表？此外，我希望能够在VBA中对此进行编程，以便我可以按下Excel工具栏上的按钮导出到我的访问数据库

Answer 1

我使用此代码。

Sub ExportToAccess()
    Dim PathOfAccess As String, myFn As String
    Dim strConn As String, strSQL As String


    PathOfAccess = "C:\Users\USER\Documents\Database1.accdb"
    myFn = ThisWorkbook.FullName

    strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & PathOfAccess & ";"

    Set cn = CreateObject("ADODB.Connection")

    cn.Open strConn

strSQL = "INSERT  INTO table1  select * from [Sheet1$] IN '' " _
  & "[Excel 8.0;HDR=YES;IMEX=2;DATABASE=" & myFn & "]"

cn.Execute strSQL


End Sub

Sub ImportFromAccess()

    Dim Rs As Object
    Dim strConn As String, strSQL As String
    Dim i As Integer
    Dim Ws As Worksheet
    Dim PathOfAccess As String


    PathOfAccess = "C:\Users\USER\Documents\Database1.accdb"

    strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & PathOfAccess & ";"

    Set Rs = CreateObject("ADODB.Recordset")

    strSQL = "SELECT * FROM table1 "
    Rs.Open strSQL, strConn

    Set Ws = ActiveSheet

    If Not Rs.EOF Then
         With Ws
            .Range("a1").CurrentRegion.ClearContents
            For i = 0 To Rs.Fields.Count - 1
               .Cells(1, i + 1).Value = Rs.Fields(i).Name
            Next
            .Range("a" & 2).CopyFromRecordset Rs
        End With
    End If
    Rs.Close
    Set Rs = Nothing
End Sub

Answer 2

您可以轻松地将数据从Excel导出到Access。

Sub DAOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim db As Database, rs As Recordset, r As Long
    Set db = OpenDatabase("C:\FolderName\DataBaseName.mdb") 
    ' open the database
    Set rs = db.OpenRecordset("TableName", dbOpenTable) 
    ' get 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
    db.Close
    Set db = Nothing
End Sub

＆＃39;这是EXCEL的运行

现在，如果你想从多个Excel文件中导入数据（我假设在一个文件夹中），你可以尝试下面的脚本。

Dim strPathFile As String, strFile As String, strPath As String
 Dim strTable As String
 Dim blnHasFieldNames As Boolean

' Change this next line to True if the first row in EXCEL worksheet
 ' has field names
 blnHasFieldNames = False

' Replace C:\Documents\ with the real path to the folder that
 ' contains the EXCEL files
 strPath = "C:\Documents\"

' Replace tablename with the real name of the table into which 
 ' the data are to be imported
 strTable = "tablename"

 strFile = Dir(strPath & "*.xls")
 Do While Len(strFile) > 0
       strPathFile = strPath & strFile
       DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
             strTable, strPathFile, blnHasFieldNames

' Uncomment out the next code step if you want to delete the 
 ' EXCEL file after it's been imported
 '       Kill strPathFile

       strFile = Dir()
 Loop
' THIS RUNS IN ACCESS

将数据从Excel提交到Access

2 个答案: