Jump to content
Sign in to follow this  
x_soldier

Ajuda Código VB

Recommended Posts

x_soldier

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

Share this post


Link to post
Share on other sites
x_soldier

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

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this  

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.