none
Como acessar pasta nas nuvens/HD network de outros computadores em redes diferentes. RRS feed

  • Pergunta

  • Bom dia.

    Tenho escritorio das fabricas espalhadas em locais diferentes como mostra a figura abaixo, onde cada fabrica tem seus cadastro de funcionarios e gostaria de agrupar todos os funcionarios das unidades fabris em um arquivo de uma unica fabrica, por exemplo na Fabrica A, depois fazer gerar um DashBoard para que a Gerencia, em outro local, possa acessar a planilha dessa DashBoard.

    O que estou imaginado e que qdo tiver alteracao nos dados cadastrais de cada fabrica, pudesse acessar o OneDrive da Fabrica A para transferir as alteracoes filtrando por fabrica, deletando e colando novos dados. Cada planilha das fabricas teriam um botao de tranferencia para transferir as atualizacoes, ou seja de uma Fabrica remota, filtra a tabela do OneDrive da Fabrica A na coluna Fabrica com criterio da unidade fabril a ser alterada, deleta e cola novos dados.

    Consigo fazer o acesso do OneDrive da fabrica A com o One Drive do mesmo computador, mas como fazer o caminho para outras fabricas acessarem o OneDrive da fabrica A?, E possivel fazer?

    Desde ja agradeco um retorno.

    Tadao

    Sistema

    Planilha com Tabela da Fabrica A

    Planilha com Tabela de Dados agrupados de todas as Fabricas na Nuvem da Fabrica A

    Codigo que usei para Tranferir dados para o One Drive. Como mudar o caminho para acessar One Drive de outro sistema?

    Sub Tranferencia()
    Dim wbC As Workbook: Set wbC = ThisWorkbook
    Dim wsx As Worksheet: Set wsx = wbC.Worksheets("Aux")
    Dim wsC As Worksheet: Set wsC = wbC.Worksheets("Cadastro")
    Dim wbN As Workbook
    Dim wsN As Worksheet
    Dim buf As String
    Dim BookPath As String
    Dim myCriterio As String
    Application.ScreenUpdating = False
    
    'coloca na variavel "BookPath", o endereco da Pasta da nuvem com extencao,
    'armazenado no intervalo "Caminho"
    BookPath = wsx.Range("Caminho").Value
    myCriterio = wsx.Range("Criterio")
    
    'coloca na variavel "buf", o nome da Pasta com extencao procurada
    buf = Dir(BookPath)
    'se a variavel "buf" for "", mensagem...
    If buf = "" Then
                  MsgBox "Pasta de Trabalho => " & Range("Caminho") & _
                                "  ....nao encontrada!", , "Mensagem de Erro"
                  Exit Sub
    End If
            
    Application.DisplayAlerts = False
    
    'se a Pasta estiver fechada abre
    On Error Resume Next
    Open Range("Caminho") For Append As #1
    Close #1
    If Err.Number > 0 Then
           'pasta ja aberta, define wbN como Pasta da Nuvem
            Set wbN = Workbooks(buf)
            Set wsN = wbN.Worksheets("Cadastro")
    Else
             'abre a pasta fechada,  e define como wbN a Pasta da Nuvem
            Set wbN = Workbooks.Open(BookPath)
            Set wsN = wbN.Worksheets("Cadastro")
    End If
    'reseta o On Error
    On Error GoTo 0
    'filtra a coluna da unidade fabril
    With wsN.ListObjects(1)
            .ShowAutoFilter = False
            .Range.AutoFilter _
                    field:=.ListColumns("Fabrica").Index, _
                    Criteria1:=myCriterio
            On Error Resume Next
            'deleta os registros filtrados
            .DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
            On Error GoTo 0
            .ShowAutoFilter = False
            'copia  e cola os novos dados
            wsC.ListObjects(1).DataBodyRange.Copy
            .ListColumns(1).Range(2, 1).Offset(.ListRows.Count).PasteSpecial xlPasteValues
    End With
    wbN.Activate
    Application.ScreenUpdating = True
    MsgBox "Transferido com Sucesso", vbOKOnly, "Verificar se os Dados Foram Transferidos"
    wbC.Activate
    
    wsC.Activate
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    
    
    End Sub
    

    sexta-feira, 25 de janeiro de 2019 14:34