0

I am trying to shift from an excel database to an Access database to allow multi-user inputs. I have a userform, which asks for user inputs, and it generates a file number for them by incrementing the last file number in the database. This is the working vba code for excel as database.

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

And this is the code for access:

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

How can I achieve something similar for the File Number field with the access code? And then getting the generated file number to the newfile variable as well, so that I can show it as a MsgBox.

This is the sequence of the file numbers: INHY-101, INHY-102, INHY-103 and so on

Please help

12
  • Since the INHY is repetitive I'd drop it (or use it as my Key Field name) and use an AutoNumber key field. No code required. Commented Sep 26, 2020 at 14:23
  • I like the idea, can you tell me how will I get the AutoNumber for that field in the Msg Box? Also, I do have to maintain the database, so I need a File Number column in database as well Commented Sep 26, 2020 at 14:29
  • immediately after the .update set a bookmark .Bookmark = rst.LastModified forcing it to be the current record. You can then pull the necessary field value and assign it to a variable to be used in your MsgBox. Commented Sep 26, 2020 at 15:04
  • Can you please provide me the code for that or guide me to some link for doing that? I am really new to Access Commented Sep 26, 2020 at 15:08
  • Don't use Ms Access as Backend-Database, use a "real" RDBMS" like SQL Server, MySQL, MariaDB, Postgres or if you want a file based db use SQLite, as Ms Access is poor on data security (backup, reliability, user-control). Use it as Frontend instead of Excel-Userforms! Commented Sep 26, 2020 at 15:08

1 Answer 1

1

This is what worked for me:

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
Sign up to request clarification or add additional context in comments.

3 Comments

Problem will occur if invoice sequence exceeds 3 digits. This value is a string and alpha sort will apply. INHY-1023 sorts before INHY-240. This is another reason for not saving with the string prefix.
Either don't use string prefix and save sequence to a number field - the code changes seem obvious. Or build an ID with more digits than can ever be needed using placeholder zeros such as INHY-0000240, INHY-0001023, etc. "INHY-" & Format(rs.Fields(0) + 1, "000000"). Could even include Year in prefix and start the sequence over every year.
Did you use an AutoIncrement for File_Number? If not, don't forget to add an Unique Index on that field to prevent dupes. Also see order by strings with number numerically if neded in future.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.