Type Mismatch Error

[umamahesh2020]

Please give me reply as early as possible!!!

In this at the code "Set rs = db.OpenRecordset(SQL)" here the loop auto matically terimates

Private Sub cmd_Copy_Policy_Click()

    On Error GoTo Err_Click

    Dim db As Database
    Dim SQL As String
    Dim rs As Recordset
    Dim PolicyYear As Integer
    Dim NewYear As Integer
    Dim NewPolicyID As String
    Dim NewPolicyID_TS As String
    Dim NewPolicy_Start As Date
    Dim NewPolicy_End As Date
    
    If MsgBox("Are you sure that you want to COPY this Policy to a NEW Policy?", vbYesNo) <> vbYes Then GoTo Exit_Click
    DoCmd.RunCommand acCmdSaveRecord
        
    Set db = CurrentDb
        ' Get most recent policy for the asset
    SQL = "SELECT tbl_Policies.PolicyID, tbl_Policies.PolicyID_TS "
    SQL = SQL & "FROM tbl_Policies "
    SQL = SQL & "WHERE (((tbl_Policies.AssetID) = '" & Me.AssetID & "'))"
    SQL = SQL & "ORDER BY tbl_Policies.PolicyID DESC;"
    
    Set rs = db.OpenRecordset(SQL)
    If rs.EOF Then
        MsgBox "Error locating current policy record - No copy was made", vbOKOnly, "No Policy Record"
        GoTo Exit_Click
    End If
    
    PolicyYear = Year(Me.Policy_Start)
    rs.MoveFirst
    If Not IsNumeric(Right(rs!PolicyID, 4)) Then
        NewPolicyID = InputBox("The NEW Policy ID could not be determined - Please enter the NEW Policy ID: ", "Enter NEW Policy ID")
        NewYear = InputBox("Enter the NEW Policy YEAR Start (e.g. 2010): ", "Enter NEW Policy YEAR")
    Else
        NewYear = CInt(Right(rs!PolicyID, 4)) + 1
        NewPolicyID = Left(Me.PolicyID, Len(Me.PolicyID) - 4) & CStr(NewYear)
    End If
    
Final_Approval:
    If MsgBox("A NEW Policy with ID = '" & NewPolicyID & "' will be created based on the current Policy -- Are you sure?", vbYesNo, "Final Approval") <> vbYes Then
        If MsgBox("Do you want to enter your own Policy ID to create? ", vbYesNo, "Select your own Policy ID") = vbYes Then
            NewPolicyID = InputBox("Pleaes enter the NEW Policy ID: ", "Enter NEW Policy ID")
            GoTo Final_Approval
        Else
            GoTo Exit_Click
        End If
    End If
    
        ' Set new policy fields
    NewPolicyID_TS = Left(rs!PolicyID_TS, Len(rs!PolicyID_TS) - 4) & CStr(NewYear)
    NewPolicy_Start = DateAdd("yyyy", NewYear - PolicyYear, Me.Policy_Start)
    NewPolicy_End = DateAdd("yyyy", NewYear - PolicyYear, Me.Policy_End)
  
        ' Build new Insert SQL String to copy current Policy into a new policy with updated fields
    SQL = " INSERT INTO tbl_Policies ( PolicyID, AssetID, TermSheetID, PolicyID_TS, Policy_Number, Asset_Name, Insured_Name, Policy_Start, Policy_End, "
    SQL = SQL & "Program_Limit, Fronted_Limit, Adm_Ins_Project_Limit, Excess_Limit, Add_Excess_Limit, Fronting_Arrangement, PD_Amount, BI_Amount, Premium, "
    SQL = SQL & "Premiums_Per_Term_Sheet, Standard_Period, Indemnity_Period, Indemnity_Amount, Indemnity_Amount_Override, Project_Specific_Sublimit_Ind, "
    SQL = SQL & "Project_Specific_Sublimits, Premium_Change_Code, Premium_Change_Reason, Loss_Control_Modifier, Special_Provision, BI_Text ) "
    
    SQL = SQL & "SELECT '" & NewPolicyID & "', tbl_Policies.AssetID, tbl_Policies.TermSheetID, '" & NewPolicyID_TS & "', tbl_Policies.Policy_Number, "
    SQL = SQL & "tbl_Policies.Asset_Name, tbl_Policies.Insured_Name, #" & NewPolicy_Start & "#, #" & NewPolicy_End & "#, tbl_Policies.Program_Limit, "
    SQL = SQL & "tbl_Policies.Fronted_Limit, tbl_Policies.Adm_Ins_Project_Limit, tbl_Policies.Excess_Limit, tbl_Policies.Add_Excess_Limit, "
    SQL = SQL & "tbl_Policies.Fronting_Arrangement, tbl_Policies.PD_Amount, tbl_Policies.BI_Amount, tbl_Policies.Premium, tbl_Policies.Premiums_Per_Term_Sheet, "
    SQL = SQL & "tbl_Policies.Standard_Period , tbl_Policies.Indemnity_Period, tbl_Policies.Indemnity_Amount, tbl_Policies.Indemnity_Amount_Override, "
    SQL = SQL & "tbl_Policies.Project_Specific_Sublimit_Ind, tbl_Policies.Project_Specific_Sublimits, tbl_Policies.Premium_Change_Code, "
    SQL = SQL & "tbl_Policies.Premium_Change_Reason, tbl_Policies.Loss_Control_Modifier, tbl_Policies.Special_Provision, tbl_Policies.BI_Text "
    
    SQL = SQL & "FROM tbl_Policies "
    SQL = SQL & "WHERE (((tbl_Policies.PolicyID)='" & Me.PolicyID & "'));"
    
    DoCmd.SetWarnings False
    DoCmd.RunSQL (SQL)
    DoCmd.SetWarnings True
  
        ' Add Sub-Limit Records from prior Policy
    SQL = "INSERT INTO tbl_Sublimits ( PolicyID, SubLimit ) "
    SQL = SQL & "SELECT '" & NewPolicyID & "', tbl_Sublimits.SubLimit "
    SQL = SQL & "FROM tbl_Sublimits "
    SQL = SQL & "WHERE (((tbl_Sublimits.PolicyID)='" & Me.PolicyID & "'));"

    DoCmd.SetWarnings False
    DoCmd.RunSQL (SQL)
    DoCmd.SetWarnings True

        ' Add Deductible Records from prior Policy
    SQL = "INSERT INTO tbl_Deductible ( PolicyID, Deductible_Grp, TermSheetID_DontUse, Coverage, Deductible_Currency, Deductible_Value, Asset_Name, Business_Entity, Deductible_Order ) "
    SQL = SQL & "SELECT '" & NewPolicyID & "', tbl_Deductible.Deductible_Grp, tbl_Deductible.TermSheetID_DontUse, tbl_Deductible.Coverage, tbl_Deductible.Deductible_Currency, tbl_Deductible.Deductible_Value, tbl_Deductible.Asset_Name, tbl_Deductible.Business_Entity, tbl_Deductible.Deductible_Order "
    SQL = SQL & "FROM tbl_Deductible "
    SQL = SQL & "WHERE (((tbl_Deductible.PolicyID)='" & Me.PolicyID & "'));"
    
    DoCmd.SetWarnings False
    DoCmd.RunSQL (SQL)
    DoCmd.SetWarnings True
    
    
    rs.Close
    Me.Requery
    
Exit_Click:
    Exit Sub

Err_Click:
    MsgBox Err.Description
    Resume Exit_Click

End Sub

[AndreRet]

On which line did the error occur AND what was the error description?

[umamahesh2020]

Error at Line number:25 and Error was "Type Mismatch".

[AndreRet]

Try the following few things -

Change

Dim rs As Recordset --- Dim db As Database

to

Dim rs As DAO.Recordset
Dim db As DAO.Database

Change

Dim SQL As String

to

Dim MySqlString As String 'SQL is normally a reserved word. Where you were using "SQL", change all that to your new string name "MySqlString"

Change

Set rs = db.OpenRecordset(SQL)

to

Set rs = db.OpenRecordset(MySqlString, dbOpenDynaset)

This should solve your problem...

[umamahesh2020]

It throws as Compilation Error.

[AndreRet]

Quick question, is there a reason why you are using DAO (gathered from your code and connections)? There is a much easier way.

[umamahesh2020]

Hi AndreRet,

My Problem was Solved and Thanks for your Cooperation. By initialising components

Dim rs As DAO.Recordset
Dim db As DAO.Database

like this enough for my code.

[AndreRet]

Only a pleasure. Happy coding.:)