MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Exemplo de Sistema Multi Empresa

    Compartilhe
    avatar
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4463
    Registrado : 15/03/2013

    Exemplo de Sistema Multi Empresa

    Mensagem  ahteixeira em Qui 11 Ago 2016, 21:03

    Olá,
    A proposito de tópico e conforme prometido, segue abaixo exemplo de sistema multi empresa.

    Aproveito para postar algum código utilizado nas operações mais importantes:
    Verifica caminhos e liga à tabela de Utilizadores
    Código:
    Private Sub Form_Load()
    ' Autor ..: Alvaro Teixeira (ahteixeira)
    ' Data ...: 07-07-2016
    On Error GoTo Err_Form_Load
        
        Dim pathComuns, strTabela As String
        Dim x
        pathComuns = Application.CurrentProject.Path & "\AppDados\AppComuns.mdb"
        strTabela = "tblUtilizadores"
        
            If Not Dir(pathComuns) <> "" Then
                MsgBox "Verifique se existe o caminho e ficheiro:" & pathComuns, vbCritical, "Erro no acesso ao ficheiro"
                DoCmd.Close acForm, "frmLogin"
                DoCmd.Quit
            Else
                If fncTabelaEstaLigada(strTabela) Then
                    DoCmd.DeleteObject acTable, strTabela
                End If
                DoCmd.TransferDatabase acLink, "Microsoft Access", _
                pathComuns, acTable, strTabela, strTabela
            End If
            If fncTabelaEstaLigada(strTabela) Then
                x = Nz(DCount("NomeUtilizador", "tblUtilizadores"), 0) > 0
            End If


    Exit_Form_Load:
        Exit Sub

    Err_Form_Load:
        MsgBox Err.Number & " - " & Err.Description, vbCritical, "Erro"
        Resume Exit_Form_Load

    End Sub

    Função abrir ficheiro e ligar
    Código:
    Function fncAbrirFicheiroLigar() As String
    ' Autor ..: Alvaro Teixeira (ahteixeira)
    ' Código .: fncAbrirFicheiro
    ' Data ...: 11-08-2016
    ' Para ...: MaximoAccess.com
    ' Obs ....: Requer referencia a Microsoft Office XX Object Library
    ' Abrir, escolher ficheiro (tipo Abrir do Word),
    ' verifica tabelas da base de dados escolhida se existe ligação
    ' com mesmo nome apaga tabela(s) ligada(s)
    ' por fim liga tabelas da base de dados escolhida.
        
        On Error GoTo PROC_ERR
        
        Dim db As DAO.Database
        Dim tbl As TableDef
        Set db = CurrentDb()
        
        Dim fd As FileDialog
        Set fd = Application.FileDialog(msoFileDialogFilePicker)
        
        fd.Title = "Selecione o ficheiro da empresa"
        fd.InitialFileName = Application.CurrentProject.Path & "\AppDados\Empresas\"
        fd.Filters.Add "Ficheiro MDB", "*.mdb", 1

        fd.Show
        
        If (fd.SelectedItems.Count > 0) Then
            Dim dbe As DAO.Database
            Dim tdefs As TableDefs, tdef As TableDef
            Set dbe = DBEngine.OpenDatabase(fd.SelectedItems(1))
                For Each tdef In dbe.TableDefs
                    If Left(tdef.Name, 4) <> "MSys" Then
                        If fncTabelaEstaLigada(tdef.Name) Then DoCmd.DeleteObject acTable, tdef.Name
                        DoCmd.TransferDatabase acLink, "Microsoft Access", _
                        fd.SelectedItems(1), acTable, tdef.Name, tdef.Name
                    End If
                Next tdef
            dbe.Close
            Set dbe = Nothing

            DoCmd.Close acForm, "frmEscolheEmpresa"
            DoCmd.OpenForm "frmMenu"
        Else
            MsgBox "Operação cancelada pelo utilizador.", vbInformation, ""
        End If
        
        
    PROC_EXIT:
        db.Close
        Set db = Nothing
        Exit Function
        
        
    PROC_ERR:
        DoCmd.Hourglass False
            If Err.Number = 3011 Then
               MsgBox "Ficheiro MDB inválido.", vbCritical, ""
            Else
               MsgBox Err.Number & " - " & Err.Description, vbCritical, ""
            End If
        Resume PROC_EXIT
        
    End Function

    Função verifica se existe tabela ligada
    Código:
    Function fncTabelaEstaLigada(sNomeTabela As String) As Boolean
    ' Autor ..: Alvaro Teixeira (ahteixeira)
    ' Código .: fncTabelaEstaLigada
    ' Data ...: 07-07-2016
    ' Para ...: MaximoAccess.com
    ' Verifica apenas se existe a ligação/vinculo, não verifica se existe o ficheiro ou tabela da ligação
        
        fncTabelaEstaLigada = DCount("*", "MSysObjects", "MSysObjects.Name = '" & sNomeTabela & "' AND MSysObjects.Type = 6")

    End Function

    Abraço
    Anexos
    AppMulti_v1.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (92 Kb) Baixado 436 vez(es)
    avatar
    cleverson_manaus
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 795
    Registrado : 23/09/2011

    Re: Exemplo de Sistema Multi Empresa

    Mensagem  cleverson_manaus em Qui 11 Ago 2016, 21:10


    ahteixeira,

    vc solucionou um problema que tenho há alguns anos, tenho um programa de controle da execução crédito orçamentário, SIAFI, para cada ano crio um arquivo.

    Porém, para fazer consultas de anos anteriores tinha que sair do atual e abrir o referido arquivo do ano em questão.

    Minhas possibilidades agora são enormes.


    Valeu, muito obrigado.


    Cleverson


    .................................................................................
    [Você precisa estar registrado e conectado para ver esta imagem.]

    "É fazendo que se aprende a fazer aquilo que se deve aprender a fazer."(Aristóteles)
    - Dúvida resolvida!!! Marcar o tópico como resolvido!!!
    avatar
    anderson_cgms
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 248
    Registrado : 26/03/2012

    Re: Exemplo de Sistema Multi Empresa

    Mensagem  anderson_cgms em Qui 11 Ago 2016, 22:24

    cheers cheers cheers Muito bom, é mais uma pérola para a coleção máximo Access cheers cheers cheers


    Obrigado ahteixeira, muito obrigado mesmo.

    m_araujo
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 95
    Registrado : 15/11/2012

    Re: Exemplo de Sistema Multi Empresa

    Mensagem  m_araujo em Sex 12 Ago 2016, 14:05

    Obrigado, ahteixeira!

    muito obrigado.
    avatar
    FabioPaes
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3336
    Registrado : 14/08/2013

    Re: Exemplo de Sistema Multi Empresa

    Mensagem  FabioPaes em Sex 12 Ago 2016, 14:57

    Olha que maravilha mestre ahteixeira, ficou muito bom mesmo o exemplo... Irei esmiuçar esses codigos assim que possivel... Novos conhecimentos e sempre bem vindo!

    Obrigado por compartilhar!


    .................................................................................
    _____________________________________________________________________
    Achou a solução para sua dúvida? Não seja Egoísta, Compartilhe com todos!
    A dica do Colega foi útil? Agradeça!

    O importante não saber tudo, mas sim a Onde procurar!
    avatar
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4463
    Registrado : 15/03/2013

    Re: Exemplo de Sistema Multi Empresa

    Mensagem  ahteixeira em Sab 13 Ago 2016, 02:08

    Olá, é gratificante saber que é útil o exemplo postado.
    Obrigado pelo retorno.
    Isto é que é ser MaximoAccess Wink
    Abraço e bons estudos

      Data/hora atual: Qua 18 Out 2017, 10:27