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

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...

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

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.

This question has already been answered. Start a new discussion instead.