CopyFromRecordset Not Working
I finally Figure it out.
Do
On Error Resume Next 'reset Err.obj.

 'Get the Max ID +1
Set rst = Nothing
Set rst = New ADODB.Recordset 'assign memory to the recordset
SQL = &quot;SELECT Max(ApNumber)+1 FROM PayVoucherID &quot;
rst.Open SQL, cnn

'Check if the recordset is empty.
'Copy Recordset to the Temporary Cell
Sheets(&quot;MAX&quot;).Range(&quot;A2&quot;).CopyFromRecordset rst

'Insert the Data to Database And Check If no Errors
Sql2 = &quot;INSERT INTO PayVoucherID(ApNumber)Values('&quot; &amp; Sheets(&quot;MAX&quot;).Range(&quot;A2&quot;) &amp; &quot;') &quot;
cnn.Execute Sql2
Loop Until (Err.Number = 0)}