将用户表单提交到 Access 数据库时自动增加字母数字字符串

Posted 2023-05-07

【中文标题】将用户表单提交到 Access 数据库时自动增加字母数字字符串

【英文标题】：Increment alphanumeric string automatically while submitting userform to Access database

【发布时间】：2020-09-26 12:50:07

【问题描述】：

我正在尝试从 excel 数据库转移到 Access 数据库以允许多用户输入。 我有一个用户表单，它要求用户输入，并通过递增数据库中的最后一个文件号为他们生成一个文件号。这是 excel 作为数据库的工作 vba 代码。

Sub Submit()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.AutomationSecurity = msoAutomationSecurityLow
    If frmForm.txtDosage.Value = "" Or frmForm.txtProject.Value = "" Or frmForm.txtTime.Value = "" Then
        MsgBox ("Complete All fields marked with (*) to proceed")
    Else
    
        Dim nwb As Workbook
        Set nwb = Workbooks.Open("C:\Users\CHAMARA2.APNET\Automatic File Number Creation\AFNC Database.xlsm")
        Dim emptyRow As Long
        Dim lastinvoice As String
        Dim newfile As String
        
        emptyRow = WorksheetFunction.CountA(nwb.Sheets("Sheet1").Range("A:A")) + 1
        lastinvoice = nwb.Sheets("Sheet1").Cells(emptyRow - 1, 7)
        
        With nwb.Sheets("Sheet1")
        
            .Cells(emptyRow, 1) = emptyRow - 1
            .Cells(emptyRow, 2) = frmForm.txtProject.Value
            .Cells(emptyRow, 3) = frmForm.txtDosage.Value
            .Cells(emptyRow, 5) = frmForm.txtTime.Value
            .Cells(emptyRow, 6) = Application.UserName
            .Cells(emptyRow, 4) = frmForm.cmbPurpose.Value
            .Cells(emptyRow, 7) = Left(lastinvoice, 4) & "-" & Format(Int(Right(lastinvoice, 3)) + 1, "000")
            .Cells(emptyRow, 8) = Date
            newfile = .Cells(emptyRow, 7).Value
        End With
        
    End If
    MsgBox ("Your generated file number is " & newfile)
    nwb.SaveAs Filename:="C:\Users\CHAMARA2.APNET\Automatic File Number Creation\AFNC Database.xlsm"
    nwb.Close
End Sub

这是访问代码：

Sub Submit2()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.AutomationSecurity = msoAutomationSecurityLow
    If frmForm.txtDosage.Value = "" Or frmForm.txtProject.Value = "" Or frmForm.txtTime.Value = "" Then
        MsgBox ("Complete All fields marked with (*) to proceed")
    Else
        Dim cnn As New ADODB.Connection 'dim the ADO collection class
        Dim rst As New ADODB.Recordset 'dim the ADO recordset class
        Dim dbPath As String
        
        dbPath = "C:\Users\CHAMARA2.APNET\Downloads\TestDB.accdb"
        
        cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
        
        Set rst = New ADODB.Recordset 'assign memory to the recordset
        
        rst.Open Source:="FileNumbers", ActiveConnection:=cnn, _
        CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
        Options:=adCmdTable
        
        'Dim emptyRow As Long
        'Dim lastinvoice As String
        'Dim newfile As String
        
        'emptyRow = WorksheetFunction.CountA(nwb.Sheets("Sheet1").Range("A:A")) + 1
        'lastinvoice = nwb.Sheets("Sheet1").Cells(emptyRow - 1, 7)
        
        With rst
        
            .AddNew
            .Fields("Project").Value = frmForm.txtProject.Value
            .Fields("Dose").Value = frmForm.txtDosage.Value
            .Fields("Time Point").Value = frmForm.txtTime.Value
            .Fields("Submitted By").Value = Application.UserName
            .Fields("Purpose").Value = frmForm.cmbPurpose.Value
            .Fields("File Number").Value = Left(lastinvoice, 4) & "-" & Format(Int(Right(lastinvoice, 3)) + 1, "000")
            .Fields("Date Created").Value = Date
            .Update
            'newfile = .Cells(emptyRow, 7).Value
            
        End With
        
    End If
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    MsgBox ("Your generated file number is " & newfile)
    
End Sub

如何使用访问代码为文件编号字段实现类似的功能？然后将生成的文件号也获取到 newfile 变量中，以便我可以将其显示为 MsgBox。

这是文件编号的顺序：INHY-101、INHY-102、INHY-103 等等

请帮忙

【问题讨论】：

由于 INHY 是重复的，我会删除它（或将其用作我的关键字段名称）并使用自动编号关键字段。无需代码。

我喜欢这个主意，你能告诉我如何在 Msg Box 中获得该字段的自动编号吗？另外，我必须维护数据库，所以我还需要数据库中的文件号列

在 .update 之后立即设置一个书签 .Bookmark = rst.LastModified 强制它成为当前记录。然后，您可以提取必要的字段值并将其分配给要在 MsgBox 中使用的变量。

你能提供我的代码或指导我做一些链接吗？我真的是 Access 新手

不要使用 Ms Access 作为后端数据库，使用“真正的”RDBMS”，如 SQL Server、mysql、MariaDB、Postgres，或者如果您想要基于文件的数据库，请使用 SQLite，因为 Ms Access 是数据安全性差（备份、可靠性、用户控制）。将其用作前端而不是 Excel-Userforms！

【参考方案1】：

这对我有用：

Sub Submit2()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.AutomationSecurity = msoAutomationSecurityLow
    If frmForm.txtDosage.Value = "" Or frmForm.txtProject.Value = "" Or frmForm.txtTime.Value = "" Then
        MsgBox ("Complete All fields marked with (*) to proceed")
    Else
        Dim cnn As New ADODB.Connection 'dim the ADO collection class
        Dim rst As New ADODB.Recordset 'dim the ADO recordset class
        Dim dbPath As String
        Dim qry As String
        
        dbPath = "C:\Users\CHAMARA2.APNET\Downloads\TestDB.accdb"
        
        cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
        
        Set rst = New ADODB.Recordset 'assign memory to the recordset
        Set rs = New ADODB.Recordset
        
        rst.Open Source:="FileNumbers", ActiveConnection:=cnn, _
        CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
        Options:=adCmdTable
        
        qry = "SELECT max(val(mid(File_Number,6))) FROM FileNumbers"
        
        Set rs = cnn.Execute(qry)
        newfile = "INHY-" & Format(rs.Fields(0) + 1, "000")
        With rst
        
            .AddNew
            .Fields("Project").Value = frmForm.txtProject.Value
            .Fields("Dose").Value = frmForm.txtDosage.Value
            .Fields("Time Point").Value = frmForm.txtTime.Value
            .Fields("Submitted By").Value = Application.UserName
            .Fields("Purpose").Value = frmForm.cmbPurpose.Value
            .Fields("File_Number").Value = newfile
            .Fields("Date Created").Value = Date
            .Update
            
            
        End With
        'cnn.Execute "INSERT INTO TheTable.....", , adCmdText + adExecuteNoRecords
        'Set rs = cnn.Execute("SELECT @@Identity", , adCmdText)
        MsgBox ("Your generated file number is " & newfile)
    End If
    rst.Close
    rs.Close
    cnn.Close
    
    Set rs = Nothing
    Set rst = Nothing
    Set cnn = Nothing
    
End Sub

【讨论】：

如果发票序列超过 3 位会出现问题。该值是一个字符串，将应用 alpha 排序。 INHY-1023 在 INHY-240 之前排序。这是不使用字符串前缀保存的另一个原因。

不要使用字符串前缀并将序列保存到数字字段 - 代码更改似乎很明显。或者使用占位符零（例如 INHY-0000240、INHY-0001023 等"INHY-" & Format(rs.Fields(0) + 1, "000000")）构建一个比以往任何时候都需要更多位数的 ID。甚至可以在前缀中包含 Year 并从每年开始序列。

您是否对File_Number 使用了自动增量？如果没有，不要忘记在该字段上添加Unique Index 以防止被骗。如果将来需要，请参阅order by strings with number numerically。