Question

我有一个excel表单的下面代码，目前将数据保存在另一个excel中。唯一的问题是，如果超过1个人试图发送数据，这不能正常工作。是否可以以将数据发送到访问数据库的方式生成代码？这是我的代码。

Sub UpdateLogWorksheet()
Dim historyWks As Worksheet
Dim inputWks As Worksheet
Dim historyWb As Workbook '<~ target workbook

Dim nextRow As Long
Dim oCol As Long

Dim myRng As Range
Dim myCopy As String
Dim myCell As Range

'cells to copy from Input sheet - some contain formulas
myCopy = "D5,D7,D9,D11,D13"

Set inputWks = Worksheets("Input")
Set historyWb = Workbooks.Open("C:\reports\consolidated.xlsx") '<~ open target workbook and     assign sheet
Set historyWks = historyWb.Worksheets("PartsData")

With historyWks
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With

With inputWks
Set myRng = .Range(myCopy)

If Application.CountA(myRng) <> myRng.Cells.Count Then
    MsgBox "Please fill in all the cells!"
    Exit Sub
End If
End With

With historyWks
With .Cells(nextRow, "A")
    .Value = Now
    .NumberFormat = "mm/dd/yyyy hh:mm:ss"
End With
.Cells(nextRow, "B").Value = Application.UserName
oCol = 3
For Each myCell In myRng.Cells
    historyWks.Cells(nextRow, oCol).Value = myCell.Value
    oCol = oCol + 1
Next myCell
End With

historyWb.Save '<~ save and close the target workbook
historyWb.Close SaveChanges:=False

'clear input cells that contain constants
With inputWks
On Error Resume Next
 With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
      .ClearContents
      Application.GoTo .Cells(1) ', Scroll:=True
 End With
On Error GoTo 0
End With
End Sub

Answer 1

您可以使用此代码将数据从Excel放入AccessDB：

Option Explicit
Dim con, rst, t0, i, s, xx, n
Const adUseClient = 3
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const useTransaction = True

Set con = CreateObject("ADODB.Connection")
con.CursorLocation = adUseClient
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=e:\0\a\db1.accdb;"
Set rst = CreateObject("ADODB.Recordset")
rst.Open "SELECT * FROM Table1", con, adOpenStatic, adLockOptimistic
If useTransaction Then
    con.BeginTrans
End If
i = 1
For i = 1 To Range("Dati").Rows.Count
    rst.AddNew
    rst("FirstName").Value = Range("Dati").Cells(i, 1).Value
    rst("LastName").Value = Range("Dati").Cells(i, 2).Value
    rst("Birday").Value = Range("Dati").Cells(i, 3).Value
    rst.Update
Next
If useTransaction Then con.CommitTrans
rst.Close
Set rst = Nothing
con.Close
Set con = Nothing

并将所有数据放在Table1中。所有数据都来自名为Dati的范围我有配方，你想保存配方使用：

Range("Dati").Cells(i, 1).Formula

使用此代码，您只需将Excel文件中的数据放入AccessDB文件中，而无需检查双倍数据......

Excel表单用于在访问数据库中保存数据

1 个答案: