Ir para o conteúdo
  • Revista PROGRAMAR: Já está disponível a edição #60 da revista programar. Faz já o download aqui!

sagostinho

código vba detectar localização

Mensagens Recomendadas

sagostinho

olá será que me podiam ajudar não sei se é possível mas o que eu queria fazer era o seguinte la no trabalho tenho feito alguns ficheiros que estão dentro da minha pasta o que acontece é que vão dentro da minha pasta e copiam-os para outras pasta e ficam com os louvores o que eu queria era um código vba que ao abrir o ficheiro detecta-se a localização do tipo (c:\min\sa) e se não fosse a localização da minha pasta o ficheiro fechava-se não sei se é possivel não percebo muito de vba  mas se pudessem ajudar agradecia muito obrigado.

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
jmaocubo

Boa tarde

Em anexo envio-te ficheiro com o que pretendes....

Faz o teste e não vais conseguir abrir o ficheiro até criares uma pasta com o nome "m" na directoria c:\

Ficando: c:\m

Depois no código em VBA muda para o que pretendes (a tua directoria).

Saliento e chamo a atenção para o seguinte:

1) Não sei se tens as tuas folhas a executar macros!!! se são apenas formulas na sheet qualquer um poderá desactivar as macros e aceder ao teu ficheiro.

2) Para evitares que usem o teu trabalho, obrigando-os a executar este codigo poderás introduzir o código de "force enable macros" (existe vários sites que explicam como, mas depois poderemos falar sobre isso e dou-te uma ajuda).

3) os códigos presentes no VBA estão no module1 e no Estelivro

Procedimento:

ALT+F11

Criar um module

No "module"colar:

Public Function FileFolderExists(strFullPath As String) As Boolean


    On Error GoTo EarlyExit
    If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True
    
EarlyExit:
    On Error GoTo 0

End Function



Public Sub aa()


    If FileFolderExists("c:\m") Then ' <= muda aqui para a directoria correcta
        MsgBox "Autorizado"
    Else
        MsgBox "Não Autorizado!"
        ThisWorkbook.Close
        
    End If

End Sub

No "EsteLivro"

Colar:

Private Sub Workbook_Open()
Call aa
End Sub

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
sagostinho

:) :cheesygrin:és o maior obrigada era mesmo isto que queria obrigada mesmo :cheesygrin:.

Só mais uma coisa há alguma maneira de saber quem esta a utilizar um livro de excel ex. quando abrimos um livro e ja alguem o tem aberto so o podemos abrir de leitura ha alguma maneira de saber quantas pessoas estão a utilizar e quem o nosso livro.

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
jmaocubo

:) :cheesygrin:és o maior obrigada era mesmo isto que queria obrigada mesmo :cheesygrin:.

Só mais uma coisa há alguma maneira de saber quem esta a utilizar um livro de excel ex. quando abrimos um livro e ja alguem o tem aberto so o podemos abrir de leitura ha alguma maneira de saber quantas pessoas estão a utilizar e quem o nosso livro.

Ainda bem que te ajudou.... mas lembra-te que é muito fácil contornar este código. Basta desactivar as macros para se ter acesso directo... quando tiver um pouco mais de tempo posso sempre mostrar como evitar isso....

Relativamente à tua questão, desconheço essa possibilidade a partir do excel (VBA).

No entanto poderás fazer de outra maneira (um pouco mais rudimentar) que é ao abrir o workbook ele grava numa célula especifica quem foram as ultimas pessoas que acederam ao ficheiro.

Para isso é necessário saber:

1) os ficheiros que colocas estão de forma "share" numa intranet da empresa. Certo?

2) todas as pessoas que poderão aceder ao teu ficheiro fazem-no através do seu posto de trabalho.

3) para acederem ao seu posto de trabalho têm que efectuar login. Certo?

Se assim for todos têm um internal name que associa o seu posto de trabalho....

Poderás assim saber quem abriu o teu ficheiro, a data e a hora a que isso aconteceu.

Cumprimentos,

 

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
jpaulino

Relativamente ao tratamento de erros essa função não está muito correcta.  :)

Dessa formas o programa vai sempre para o "EarlyExit:", o que não está muito correcto. Devias ter uma abordagem deste género:

Public Function FileFolderExists(strFullPath As String) As Boolean
On Error GoTo EarlyExit
    
    If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True
    Exit Function
    
EarlyExit:
    FileFolderExists = False

End Function

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
jmaocubo

Relativamente ao tratamento de erros essa função não está muito correcta.  :)

Dessa formas o programa vai sempre para o "EarlyExit:", o que não está muito correcto. Devias ter uma abordagem deste género:

Public Function FileFolderExists(strFullPath As String) As Boolean
On Error GoTo EarlyExit
    
    If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True
    Exit Function
    
EarlyExit:
    FileFolderExists = False

End Function

Obrigado jpaulino  :cheesygrin:

Efectivamente não tive a percepção do

exit function

e o earlyexit estava a ser sempre executado.

No entanto, e sendo o código executado apenas na abertura do workbook não influencia a consistência dele. E pergunto: o facto de estar a executar mais essa linha de código que não é necessária influencia a sua performance?

Mais uma vez obrigado.... é assim que se vai corrigindo alguns "vícios maus"  :)

cumprimentos,

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
MetalFatigue

Ambas as soluções estão correctas em termos de objectivo, apesar de a solução do Paulino está "mais melhor bem" :)

Penso no entanto que o jmaocubo cometeu um erro de abordagem. Pelo que entendi as pessoas têm cada um uma pasta na mesma drive (fisica ou rede). Assim sendo a solução apresentada estará sempre autorizada, mesmo que se mova para outra pasta. Deveria-se era comparar a pasta do ficheiro com a pasta em que deveria de estar. Ou seja isto:

Public Sub aa()


    If ActiveWorkbook.Path = "c:\m" Then ' <= muda aqui para a directoria correcta
        MsgBox "Autorizado"
    Else
        MsgBox "Não Autorizado!"
        ThisWorkbook.Close
        
    End If

Outra questão prende-se com alguém que perceba minimamente de VBA pode alterar ou apagar esse código e gravar para a pasta que quer o ficheiro. Tens de proteger, portanto, o código.

sagostinho, na janela de VBA vais ao menu tools-->VBA project properties... e na tab protection, metes o visto na caixa e escolhes a password que queres. Depois é só gravar o ficheiro e não esquecer a password.

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
jmaocubo

Outra questão prende-se com alguém que perceba minimamente de VBA pode alterar ou apagar esse código e gravar para a pasta que quer o ficheiro. Tens de proteger, portanto, o código.

sagostinho, na janela de VBA vais ao menu tools-->VBA project properties... e na tab protection, metes o visto na caixa e escolhes a password que queres. Depois é só gravar o ficheiro e não esquecer a password.

Viva...

Uma das afirmações que fiz é a facilidade de remover a protecção. Mesmo com password no visualbasic é possivel contornar o código, caso a folha de cálculo não necessite de nenhum código em vba, ou seja, somente utilize formulas. Basta para isso colocar a segurança das macros em alto para não deixar executar.

A solução a meu ver passa por utilizar os comandos de hide das worksheets e depois ter um código para as mostrar e claro para isso é necessário que a segurança das macros esteja aceitável ou obrigar a executar mesmo.

Existe alguns artigos sobre isso: "force enable macros"

Outra situação é quando referes "ActiveWorkbook.Path". Quando utilizo o "FileFolderExists" este já vai buscar à função o fullpath.

cumprimentos,

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
MetalFatigue

Sim, sem dúvida que também precisa de forçar as macros. Não pus isso em causa.

Agora o que o teu código faz é verificar se um determinado directório existe. Não verifica se o ficheiro aberto se encontra nesse directório. Ou seja se trabalhares no mesmo PC onde está esse directório, podes ter o ficheiro onde quiseres, porque o directório continua a existir.

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
jmaocubo

Sim, sem dúvida que também precisa de forçar as macros. Não pus isso em causa.

Agora o que o teu código faz é verificar se um determinado directório existe. Não verifica se o ficheiro aberto se encontra nesse directório. Ou seja se trabalhares no mesmo PC onde está esse directório, podes ter o ficheiro onde quiseres, porque o directório continua a existir.

MetalFatigue tens toda a razão :cheesygrin: não tive a percepção que a pasta existirá sempre independentemente de estar a executar de uma outra localização.....

Sendo assim basta colocar em Estelivro:

Private Sub Workbook_Open()
Call aa
End Sub

e no module:

Public Sub aa()


    If ActiveWorkbook.Path = "C:\m" Then ' <= muda aqui para a directoria correcta
     MsgBox "Autorizado"
    Else
        MsgBox "Não Autorizado!"
        ThisWorkbook.Close
       
    End If
End Sub

Obrigado pela correcção!!!!!! :P

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
sagostinho
:P mais uma vez obrigada ao jmaocubo, MetalFatigue e jpaulino pois o ultimo código funciona na perfeição e era mesmo aquilo que eu queria e tinha idealizado tirovos o chapéu  vocês são espectaculares e muito metem-em ajudado e também toda a comunidade deste fórum. OBRIGADO

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!

Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.

Entrar Agora

×

Aviso Sobre Cookies

Ao usar este site você aceita os nossos Termos de Uso e Política de Privacidade. Este site usa cookies para disponibilizar funcionalidades personalizadas. Para mais informações visite esta página.