Ajuda Código VB

[x_soldier 0]

Boas pessoal.

Tenho um código VB num Excel que utilizo para inserir registos numa Base de Dados Access, queria fazer-lhe uma alteração que já tentei mas sem sucesso:

O código que tenho é o seguinte:

Sub InsertPositions()

Dim conn As ADODB.Connection 'Variável para a Base Dados
Dim rs As ADODB.Recordset 'Variável para a Tabela
Dim r As Long 'Variável para o número da linha da Sheet

   Set conn = New ADODB.Connection
   Set rs = New ADODB.Recordset

'Conectando á Base de Dados Access
  conn.ConnectionString = "Provider=MSDASQL.1;Password=VanFor;Persist Security Info=True;Data Source=VanFor"
   conn.Open
   rs.ActiveConnection = conn

rs.Open "Agregados", conn, adOpenKeyset, adLockOptimistic, adCmdTable 'Todos os registros da tabela

'Número da linha que irá começar na Sheet
r = 6

'Repete enquanto a coluna "A" for maior que Zero
If Range("D3") = "" Then

   Do While Len(Range("A" & r).Formula) > 0

With rs
'Insere novo registo na Base de Dados
.AddNew

'Adiciona valores para cada campo na tabela
.Fields("CD") = Range("A" & r).Value
.Fields("CI") = Range("B" & r).Value
.Fields("CodigoISIN") = Range("C" & r).Value
'.Fields("NumOrdAgregado") = Range("D" & r).Value
.Fields("NombreISIN") = Range("E" & r).Value
.Fields("Remitente") = Range("F" & r).Value
.Fields("Declarante") = Range("G" & r).Value
.Fields("Periodo") = Range("H" & r).Value
.Fields("Prueba") = Range("I" & r).Value
.Fields("Epigrafe") = Range("J" & r).Value
.Fields("Titular") = Range("K" & r).Value
.Fields("Pais") = Range("L" & r).Value
.Fields("Emisor") = Range("M" & r).Value
.Fields("SaldoInicialNValores") = Range("N" & r).Value
.Fields("SaldoInicialImporte") = Range("O" & r).Value
.Fields("EntradasSinPrecioNValores") = Range("P" & r).Value
.Fields("SalidasSinPrecioNValores") = Range("Q" & r).Value
.Fields("EntradasNValores") = Range("R" & r).Value
.Fields("EntradasImporteEfectivo") = Range("S" & r).Value
.Fields("SalidasNValores") = Range("T" & r).Value
.Fields("SalidasImporteEfectivo") = Range("U" & r).Value
.Fields("CuponDivNValores") = Range("V" & r).Value
.Fields("CuponDivImporteEfectivo") = Range("W" & r).Value
.Fields("SaldoFinalNValores") = Range("X" & r).Value
.Fields("SaldoFinalImporte") = Range("Y" & r).Value
.Fields("Desglose") = Range("Z" & r).Value
.Fields("NumDesglose") = Range("AA" & r).Value
.Fields("IdDeclarante") = Range("AB" & r).Value
'Actualiza o novo registro
.Update
Counter = Counter + 1
End With

'Próxima linha da Sheet para a Base Dados
r = r + 1
Loop

'Fecha a tabela
rs.Close
Set rs = Nothing

'Fecha a Base de Dados
conn.Close
Set conn = Nothing

MsgBox "Inseridos na Base de Dados " & Counter & " Registos"
Range("D3") = "a"

   Else
	    MsgBox "Registos já inseridos na Base de Dados"
   End If

End Sub

Queria antes do "insert" fazer uma query do género da de baixo ao access e quando essa query retorna-se registos não fazer o insert.

"SELECT * from Agregados where Periodo='" & Sheets("Posicao").Cells(i, 14) _
				    & "' And CD='" & Sheets("Posicao").Cells(i, 15) _
				    & "' And Epigrafe=" & Sheets("Posicao").Cells(i, 16) _
				    & " And Titular='" & Sheets("Posicao").Cells(i, 17) _
				    & "' And CodigoISIN='" & Sheets("Posicao").Cells(i, 18) & "'"

Alguém pode dar uma ajudinha, sff.

Obrigado

[x_soldier 0]

Resolvido!

Sub InsertPositions()
   Set conn = New ADODB.Connection 'Variável para a Base Dados
   Set rs = New ADODB.Recordset 'Variável para a Tabela
   Dim r As Long 'Variável para o número da linha da Sheet
   Counter = 0 'Iniciar Contador de Registos

   rs.CursorType = adOpenKeyset
   rs.LockType = adLockOptimistic

 'Conexão á Base de Dados Access
  conn.ConnectionString = "Provider=MSDASQL.1;Password=VanFor;Persist Security Info=True;Data Source=VanFor"
   conn.Open
   rs.ActiveConnection = conn

   'Encontrar Fim da Sheet
   Set c = Sheets("Inserir Posições").Range("A5").End(xlDown)

   'Número da linha que irá começar na Sheet
   For r = 6 To c.Row

   connstr = "SELECT * from Agregados where Periodo='" & Sheets("Inserir Posições").Cells(r, 8) _
			 & "' And CD='" & Sheets("Inserir Posições").Cells(r, 1) _
			 & "' And Epigrafe=" & Sheets("Inserir Posições").Cells(r, 10) _
			 & " And CodigoISIN='" & Sheets("Inserir Posições").Cells(r, 3) & "'"


    rs.Open connstr
    If rs.EOF Then

    'Insere novo registo na Base de Dados
    rs.AddNew
    'Adiciona valores para cada campo na tabela
    rs.Fields("CD") = Range("A" & r).Value
    rs.Fields("CI") = Range("B" & r).Value
    rs.Fields("CodigoISIN") = Range("C" & r).Value
    rs.Fields("NombreISIN") = Range("E" & r).Value
    rs.Fields("Remitente") = Range("F" & r).Value
    rs.Fields("Declarante") = Range("G" & r).Value
    rs.Fields("Periodo") = Range("H" & r).Value
    rs.Fields("Prueba") = Range("I" & r).Value
    rs.Fields("Epigrafe") = Range("J" & r).Value
    rs.Fields("Titular") = Range("K" & r).Value
    rs.Fields("Pais") = Range("L" & r).Value
    rs.Fields("Emisor") = Range("M" & r).Value
    rs.Fields("SaldoInicialNValores") = Range("N" & r).Value
    rs.Fields("SaldoInicialImporte") = Range("O" & r).Value
    rs.Fields("EntradasSinPrecioNValores") = Range("P" & r).Value
    rs.Fields("SalidasSinPrecioNValores") = Range("Q" & r).Value
    rs.Fields("EntradasNValores") = Range("R" & r).Value
    rs.Fields("EntradasImporteEfectivo") = Range("S" & r).Value
    rs.Fields("SalidasNValores") = Range("T" & r).Value
    rs.Fields("SalidasImporteEfectivo") = Range("U" & r).Value
    rs.Fields("CuponDivNValores") = Range("V" & r).Value
    rs.Fields("CuponDivImporteEfectivo") = Range("W" & r).Value
    rs.Fields("SaldoFinalNValores") = Range("X" & r).Value
    rs.Fields("SaldoFinalImporte") = Range("Y" & r).Value
    rs.Fields("Desglose") = Range("Z" & r).Value
    rs.Fields("NumDesglose") = Range("AA" & r).Value
    rs.Fields("IdDeclarante") = Range("AB" & r).Value
    'Actualiza o novo registro
    rs.Update
    rs.MoveNext
    'Sheets("Inserir Posições").Range("AD" & r).Value = "OK"
	  Counter = Counter + 1

	  Else

	    'Sheets("Inserir Posições").Range("AD" & r).Value = "NOK"
    End If

    rs.Close
	    Next r

   'Fecha a Base de Dados
   conn.Close

MsgBox "Inseridos na Base de Dados " & Counter & " Registos"
End Sub