x_soldier 0 Posted December 19, 2013 Report Share Posted December 19, 2013 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 Link to post Share on other sites
x_soldier 0 Posted December 19, 2013 Author Report Share Posted December 19, 2013 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 Link to post Share on other sites
Recommended Posts
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 accountSign in
Already have an account? Sign in here.
Sign In Now