Boa noite amigo entao eu uso o mysql porem creio que so deve mudar a instrução de conexão abaixo segue os códigos que uso para acessar e usar as store procedures. como exemplo usando uma procedure de consulta fazendo a inclusao dos dados na tabela.
aqui estão em um modulo_conexão
1- Aqui esta os dados para conexão
Public Function MySQL_Server()
MyslqServidor = DLookup("[Servidor]", "_parametros") 'Servidor Web
MyslqUsuario = DLookup("[Usuario]", "_parametros") 'Usuário do banco de dados
MyslqSenha = DLookup("[Senha]", "_parametros") 'Senha do banco de dados
MyslqDatabase = DLookup("[Banco_Dados]", "_parametros") 'Database
MyslqDriver = DLookup("[Driver]", "_parametros")
End Function
2- aqui abre a conexão
Public Function Conecta()
On Error GoTo trata_erro
Dim blnConn As Boolean
Dim myDriver As String
'se a conexão estiver aberta e o nome do DB for igual ao nome do DB do parâmetro
'Então está conectado
If cn.State = 1 And cn.DefaultDatabase = MyslqDatabase Then
Conecta = True
Exit Function
End If
'Se a conexão estiver fechada então vá para seção de abertura
If cn.State = 0 Then
blnConn = True
GoTo CONECTA_DB
End If
If cn.State = 0 And (IsNull(cn.DefaultDatabase) Or Trim(cn.DefaultDatabase) = Empty) Then
blnConn = True
ElseIf cn.State = 1 And (IsNull(cn.DefaultDatabase) Or Trim(cn.DefaultDatabase) = Empty) Then
Call Desconecta
blnConn = True
Else
blnConn = False
End If
CONECTA_DB:
Call MySQL_Server 'Carrega parametros do servidor
myDriver = "driver={" & MyslqDriver & "}"
If blnConn = True Then
With cn
.CursorLocation = adUseClient
.ConnectionTimeout = 0
.CommandTimeout = 0
.ConnectionString = "" & myDriver & ";" & _
"SERVER=" & MyslqServidor & ";" & _
"DATABASE=" & MyslqDatabase & ";" & _
"USER=" & MyslqUsuario & ";" & _
"PASSWORD=" & MyslqSenha & ";" & _
"OPTION=3;"
.Open
End With
End If
Exit Function
trata_erro:
blnConn = True
GoTo CONECTA_DB
MsgBox "Erro gerado: " & Err.Number & " - " & Err.Description & "" & _
vbCrLf & " O sistema será encerrado.", vbCritical + vbOKOnly + vbApplicationModal, "Erro de Conexão"
Set cn = Nothing
Exit Function
End Function
3- aqui e a função no formulario que estão em um botão detalhe que
no cabeçalho do formulário:
Option Explicit
Option Compare Database
Dim cSQL As String
Dim strWhere As String
Dim strColunas As String
Dim rsdao As DAO.Recordset
Dim DB As DAO.Database
'Dim x As Integer
'Dim strNomeCol As String
'Dim strTamCol As String
'Dim wsql As String
Dim rsvarios As New ADODB.Recordset
Dim rsvoucher As New ADODB.Recordset
Dim rsadiantamento As New ADODB.Recordset
Dim blnAchou As Boolean
Dim blnAchou2 As Boolean
Dim SSQLEN
Dim taxacom As Double
Dim sSQL As String
Dim rst As DAO.Recordset
Dim nReg As Long
Dim nReg1 As Long
Dim objRSC
Private Sub MontaLista()
Dim sqlDAO As String
'On Error GoTo trata_erro
CurrentDb.Execute "delete * from Grid_Conta;"
Rem abrindo tabela temporária somente para adição de dados
Set objRSC = CurrentDb.OpenRecordset("Grid_Conta", ,
Me.Grid_Conta_Acerto.Requery
strWhere = " WHERE "
strColunas = Empty
If Not IsNull(CBXGUIA) Or Trim(CBXGUIA) <> Empty Then
strWhere = strWhere & " idfornecedor = ''" & CBXGUIA & "''"
strWhere = strWhere & " AND "
End If
strWhere = Mid(Trim(strWhere), 1, Len(Trim(strWhere)) - 3)
Call Conecta aqui abre a conexão
cSQL = "CALL sp_conta_relatorio (' " & strWhere & "') " aqui e onde chama a procedure e passa os parametros da consulta.
rsvarios.Open cSQL, cn, adOpenKeyset, adLockReadOnly
'Informa a variavel booleana conforme a contagem de registros
blnAchou = IIf((rsvarios.RecordCount) > 0, True, False)
While (Not rsvarios.EOF)
objRSC.AddNew
objRSC.Fields("idconta").Value = rsvarios.Fields("idconta").Value
objRSC.Fields("status").Value = rsvarios.Fields("status").Value
objRSC.Fields("datalancamento").Value = rsvarios.Fields("datalancamento").Value
objRSC.Fields("idfornecedor").Value = rsvarios.Fields("idfornecedor").Value
objRSC.Fields("fornecedor").Value = rsvarios.Fields("fornecedor").Value
objRSC.Fields("datavencimento").Value = rsvarios.Fields("datavencimento").Value
objRSC.Fields("valorconta").Value = rsvarios.Fields("valorconta").Value
objRSC.Fields("obs").Value = rsvarios.Fields("obs").Value
objRSC.Fields("datapago").Value = rsvarios.Fields("datapago").Value
objRSC.Fields("valorpago").Value = rsvarios.Fields("valorpago").Value
objRSC.Update
rsvarios.MoveNext 'vai para o proximo registro
Wend
Call FN_FechaRst(rsvarios)
Me.Grid_Conta_Acerto.Requery
'End If
Exit Sub
'trata_erro:
'Call FN_FechaRst(rsdados)
'Exit Sub
End Sub
espero ter ajudado e como falei acho que so muda a instrução do sql serve essa aqui
.ConnectionString = "" & myDriver & ";" & _
"SERVER=" & MyslqServidor & ";" & _
"DATABASE=" & MyslqDatabase & ";" & _
"USER=" & MyslqUsuario & ";" & _
"PASSWORD=" & MyslqSenha & ";" & _
"OPTION=3;"
.Open
detalhe que eu uso uma tabela para guardar os dados de conexão
Início
ifahidalgo 28/5/2020, 22:43
