Notifications
Clear all

Problemas em executar Consulta no Access

2 Posts
2 Usuários
0 Reactions
1,248 Visualizações
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Senhores,

Estou com problemas ao executar esse código, a intenção é executar duas consultas existentes no Access, uma para apagar dados antigos e outra para inserir os novos dados.
Preciso que essa macro seja executada, com o access fechado....

Se executo apenas uma vez, ok, na segunda vez q executo ele dá a mensagem: "Não é possivel abrir o banco de dados, é possivel que o banco de dados não seja reconhecido pelo seu aplicativo ou esteja corrompido"

Ai fecho o Excel e o Access, executo novamente e funciona perfeitamente.

Antecipo agradecimentos.

Public Sub ConectaDB()

Dim con As ADODB.Connection
Dim cmd As ADODB.Command
Dim rs As ADODB.Recordset
Dim DBPath As String

Set con = New ADODB.Connection
Set cmd = New ADODB.Command
Set rs = New ADODB.Recordset

DBPath = ThisWorkbook.Path & "dadosBDAle.accdb"

With con
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBPath
.Open
End With
Set bd = CreateObject("Access.Application")

bd.OpenCurrentDatabase DBPath
bd.Visible = False

' On Error GoTo ExibeErro

Call DoCmd.SetWarnings(False)
Call DoCmd.OpenQuery("cns_Delete", acViewNormal, acEdit) ' Deleta Dados antigos
Call DoCmd.SetWarnings(True)

Call DoCmd.SetWarnings(False)
Call DoCmd.OpenQuery("cns_Insert") ' Insere dados atualizados
Call DoCmd.SetWarnings(True)

bd.Close
bd.Quit
Set bd = Nothing

MsgBox "Atualização efetuada com Sucesso!"

End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 20/05/2014 3:11 pm
Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

Sir Wences,

Boa Noite!

Tente colocar essas linhas antes de fechar o Banco de Dados. Caso não dê certo, disponibilize seus arquivo aqui (compactados com ZIP) para podermos depurar e ver o que está ocorrendo.

Set con = Nothing
Set cmd = Nothing
Set rs = Nothing
Set bd = Nothing
bd.Close
bd.Quit

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 20/05/2014 6:38 pm