I am attempting to paste from an excel spreadsheet into an access subform.
The call to the NotInList module is as follows:
Private Sub FinishCombo_NotInList(NewData As String, Response As Integer)
Call ComboNotInList(NewData, Response, "Finish", "Finishes", "", "")
End Sub
The NotInListModule is as follows:
Option Compare Database
Option Explicit
Public Sub ComboNotInList(ByVal vstrNew As String, ByRef rintResponse As Integer, _
ByVal vstrField As String, ByVal vstrTable As String, varWhere As Variant, ByVal vstrArgs As String)
If vstrNew <> LTrim(vstrNew) Then
MsgBox "Leading blanks are not allowed"
' vstrNew = LTrim(vstrNew)
rintResponse = acDataErrContinue
Exit Sub
End If
If InStr(1, vstrNew, "'") <> 0 Or InStr(1, vstrNew, """") <> 0 Then
MsgBox "Quotes may not be entered here"
rintResponse = acDataErrContinue
Exit Sub
End If
If vstrArgs = "NoAdd" Then
rintResponse = MsgBox("Please pick a number from the list or hit the 'esc' key twice to return to previous value", 0, vstrField & " is not valid")
rintResponse = acDataErrContinue
Exit Sub
End If
If vstrField = "RegCat" Then
rintResponse = MsgBox("Category is not valid. Would you like to add it?", vbYesNo)
Else
rintResponse = MsgBox(vstrField & " is not valid. Would you like to add it?", vbYesNo)
End If
If rintResponse = vbYes Then
Dim dbs As Database
Dim rst As DAO.Recordset
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(vstrTable)
rst.AddNew
If vstrTable = "Companies" Then
rst!ShortName = vstrNew
rst!CompanyName = vstrNew
If vstrArgs <> "COMPANIE" Then
rst(vstrArgs) = True
End If
Else
rst(vstrField).Value = vstrNew
If vstrField = "RegCat" Then
rst("RegCatID") = vstrNew
End If
End If
If vstrTable = "Terms" Then
If varWhere = "Sales" Then
rst!TermType = 2
Else
rst!TermType = 1
End If
End If
rst.Update
rst.Close
dbs.Close
If vstrTable = "Gifts" Then
DoCmd.OpenForm "Gifts Form", , , "[Gift]='" & vstrNew & "'"
End If
'If vstrField = "Payee/Payor" Then
' DoCmd.OpenForm "Payee Category Form", , , "[ShortName]='" & vstrNew & "'"
'End If
rintResponse = acDataErrAdded
vstrNew = ""
Else
rintResponse = acDataErrContinue
End If
End Sub