Try this:
Code:Private Sub TransferExcelFile2Database_Click() 'On Error GoTo errortrap Dim strTable1 As String Dim strTable2 As String Dim strSQL As String Dim strSQl1 As String Dim strSQLSELECT As String strTable1 = "Table3" strTable2 = "Table4" strSQl1 = "INSERT INTO " Dim strDealer As String Dim strDate As String Dim rs1 As ADODB.Recordset Set rs1 = New ADODB.Recordset Dim rs2 As ADODB.Recordset Set rs2 = New ADODB.Recordset Dim cnn As ADODB.Connection Dim mySplitArray() As String Dim myText As String Dim i As Integer Set cnn = New ADODB.Connection cnn.CursorLocation = adUseClient cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & App.path & "\sample.mdb;" strSQL = "SELECT * FROM [Report_DealerInfo$]" rs1.Open strSQL, con, adOpenStatic, adLockOptimistic Do If rs1.Fields(0) <> vbNullString Then mySplitArray = Split(rs1.Fields(0), ",") strSQLSELECT = "SELECT COUNT(*) AS recCount FROM " & strTable1 & " WHERE " strSQLSELECT = strSQLSELECT & "AREA = '" & mySplitArray(0) & "' AND " strSQLSELECT = strSQLSELECT & "DEPT_CODE = '" & mySplitArray(1) & "' AND " strSQLSELECT = strSQLSELECT & "DEALERNAME = '" & mySplitArray(2) & "' AND " strSQLSELECT = strSQLSELECT & "DEALER_MSISDN = '" & mySplitArray(3) & "' AND " strSQLSELECT = strSQLSELECT & "SUB_MSISDN = '" & mySplitArray(4) & "' AND " strSQLSELECT = strSQLSELECT & "STATUS = '" & mySplitArray(5) & "' AND " strSQLSELECT = strSQLSELECT & "ACTIVATION_ON ='" & Trim$(mySplitArray(6)) & "'" rs2.Open strSQLSELECT, cnn, adOpenStatic, adLockOptimistic If rs2![recCount] = 0 Then strSQL = " (AREA,DEPT_CODE,DEALERNAME,DEALER_MSISDN,SUB_MSISDN,STATUS,ACTIVATION_ON) VALUES(" strSQL = strSQL & "'" & mySplitArray(0) & "'," strSQL = strSQL & "'" & mySplitArray(1) & "'," strSQL = strSQL & "'" & mySplitArray(2) & "'," strSQL = strSQL & "'" & mySplitArray(3) & "'," strSQL = strSQL & "'" & mySplitArray(4) & "'," strSQL = strSQL & "'" & mySplitArray(5) & "'," strSQL = strSQL & "'" & Trim$(mySplitArray(6)) & "')" cnn.Execute strSQl1 & strTable1 & strSQL cnn.Execute strSQl1 & strTable2 & strSQL End If rs2.Close End If rs1.MoveNext Loop Until rs1.EOF rs1.Close Set rs1 = Nothing con.Close Set con = Nothing cnn.Close Set cnn = Nothing MsgBox "Data transfered" 'TransferExcelFile2Database.Enabled = False 'errortrap: MsgBox Err.Description, vbExclamation, "error" End Sub




Reply With Quote