Access inicio | | | | | |
Olá,
Seja Bem Vindo ao Blog.

Conecte-se ou registre-se e utilize gratuitamente este equipamento, temos exemplos referente a criação de banco de dados e desenvolvimento de softwares e programas utilizando o Microsoft Access.


Administração do Blog AccessDoProgramador.

Caminho do Back-End utilizando um arquivo de parâmetro

Ver o tópico anterior Ver o tópico seguinte Ir em baixo

18082011

Mensagem 

Caminho do Back-End utilizando um arquivo de parâmetro






Seção de origem no Blog: Diretório, Pastas & Parametrização


Bem amigos.. postei um exemplo èm um fórum do uso de uma função (Módulo) o qual insere valores de uma tabela em outra, com um código simples no módulo do form, que por sua vez remete à função no módulo...

Eis a adptação deste exemplo para utilização em um BackEnd onde se pode modificar o caminho do mesmo via arquivo de parâmetros..


Em um módulo

Option Compare Database
Option Explicit


Function AppendTable(toTableName As String, frmTableName As String, _
     Campo As String, Campo2, Campo3, Campo4 As String) As Boolean
     
Parametros_de_Inicializacao "SysPen.par"
Dim db As DAO.Database
Dim ws  As DAO.Workspace

Set ws = DBEngine.Workspaces(0)

   'Acrescentar a uma tabela valores de outra tabela.
   'ToTableName: Nome da tabela para inserção
   'FrmTableName: Nome da tabela dos dados de origem
   'Campo: Nome do campo que receberá os valores
   'Campo1: Nome do campo que receberá os valores
   'Campo2: Nome do campo que receberá os valores
   'Campo2: Nome do campo que receberá os valores

  'Retorna True se tiver sucesso, false caso contrário
 
'USO no Módulo do Form: AppendTable "toTableName", "frmTableName", "Campo", "Campo1, Campo2, Campo3"  
On Error GoTo errhandler
  Dim strSql As String



'Cria Append Into Select SQL da nossa sequencia dos valores dos campos  
strSql = "INSERT INTO " & toTableName & "(" & Campo & ", " & Campo2 & ", " & Campo3 & "," & Campo4 & ")" & _
        " SELECT " & "[" & frmTableName & "]." & Campo & ",[" & frmTableName & "]." & Campo2 & ", " & Campo3 & ", " & Campo4 & _
        " FROM " & frmTableName & ";"


   'Imprimir o SQL para que possamos colar na consulta construída se houver erros
  Debug.Print strSql
  'Usa o BD no diretório do mesmo
 
Set db = ws.OpenDatabase(DirBancoDados & "\Syspen_Be_Local.accdb", False, False, "MS Access;PWD=senha")

'Executa a consulta SQL Query  
db.Execute strSql

  'Se nao há erros retorna true
  AppendTable = True
ExitHere:

  Set db = Nothing

  'Notifica ao usuário que o processo está completo.
  MsgBox "Operação realizada com sucesso!"
  Exit Function
errhandler:
  'Quando há um erro retorna false
  AppendTable = False
  With err
     MsgBox "Error " & .Number & vbCrLf & .Description, _
           vbOKOnly Or vbCritical, "AppendTable"
  End With
  Resume ExitHere
End Function




Function CreateField( _
               ByVal strTableName As String, _
               ByVal strCampo As String) _
               As Boolean

'Cria um campo de texto com o nome = strCampo Na tabela strTableName
'Aceita
'StrTableName: Nome da tabela irá criar o campo
'StrCampo: Nome do novo campo
'Retorna True se tiver sucesso, false caso contrário


On Error GoTo errhandler
Dim db As DAO.Database
Dim ws  As DAO.Workspace
Dim fld As DAO.Field
Dim tdf As DAO.TableDef
Parametros_de_Inicializacao "SysPen.par"


Set ws = DBEngine.Workspaces(0)

   Set db = ws.Application(DirBancoDados & "\Syspen_Be_Local.accdb", False, False, "MS Access;PWD=senha")
   
   Set tdf = db.TableDefs(strTableName)
   'Primeiro, crie um campo com datatype = Text
   Set fld = tdf.CreateField(strCampo, dbText)

   With tdf.Fields
       .Append fld
       .Refresh
   End With
   
   CreateField = True
   
ExitHere:
   Set fld = Nothing
   Set tdf = Nothing
   Set db = Nothing
   Exit Function
errhandler:
   CreateField = False
   With err
       MsgBox "Error " & .Number & vbCrLf & .Description, _
           vbOKOnly Or vbCritical, "CreateAdditionalField"
   End With
   Resume ExitHere
End Function


Function RenameField(strTableName As String, OldstrCampo As String, strCampo As String)
' Esta rotina muda os campos na tabela strTableName.
'Aceita
'StrTableName: Nome da tabela em que vai alterar o campo
'OldstrCampo: Nome do campo Antigo
'StrCampo: Nome do novo campo
'Retorna True se tiver sucesso, false caso contrário


   Dim db As Database
   Dim td As TableDef
   Dim fld As Field
   Dim ws  As DAO.Workspace
   Parametros_de_Inicializacao "SysPen.par"


Set ws = DBEngine.Workspaces(0)
       
   On Error GoTo errhandler

    Set db = ws.OpenDatabase(DirBancoDados & "\Syspen_Be_Local.accdb", False, False, "MS Access;PWD=senha")

   Set td = db.TableDefs(strTableName)

   ' Renomeia o campo
   td.Fields(OldstrCampo).Name = strCampo
   
 

ExitHere:
   Set fld = Nothing
   Set td = Nothing
   Set db = Nothing
   Exit Function
errhandler:

   With err
       MsgBox "Error " & .Number & vbCrLf & .Description, _
           vbOKOnly Or vbCritical, "ChangeField Reference: " & OldstrCampo
   End With
   Resume ExitHere
   
End Function

Public Function ifFieldExists(fldName As String, TableName As String) As Boolean
Parametros_de_Inicializacao "SysPen.par"
Dim rs As Recordset  'Sub DAO Vars
Dim db As DAO.Database
Dim ws  As DAO.Workspace

On Error GoTo fs
Set ws = DBEngine.Workspaces(0)
'verifica se uma tabela está lá e relatórios Verdadeiro ou Falso.

Set db = ws.OpenDatabase(DirBancoDados & "\Syspen_Be_Local.accdb", False, False, "MS Access;PWD=senha")


'Se há tabela, abre-a

Set rs = db.OpenRecordset("Select " & fldName & " from " & TableName & ";")

ifFieldExists = True
rs.Close
db.Close

Exit Function

fs:
'Se a tabela nao é encontrada, fecha e seta a função para False
Set rs = Nothing
db.Close
Set db = Nothing

    ifFieldExists = False
 Exit Function
End Function


Enjoy!

avatar
Harysohn
Facilitador
Facilitador

Brasil


Voltar ao Topo Ir em baixo

- Tópicos similares
Compartilhar este artigo em: diggdeliciousredditstumbleuponslashdotyahoogooglelive

 
Permissão deste fórum:
Você não pode responder aos tópicos neste fórum