PROCV/VLOOKUP puxando dados de planilha mais recente da pasta

[thifreedom]

Boa tarde, pessoal!

 

Estou tentando consolidar as informações de várias planilhas na minha empresa em uma só, através de PROCV.

 

No entanto, as planilhas bases com as informações de que preciso, são atualizadas conforme necessário e salvas com um novo nome de revisão e pessoa que atualizou (ex.: de ORÇAMENTO REV.10 - Fulano passa para ORÇAMENTO REV.11 - Cicrano). Portanto, toda vez que as planilhas são atualizadas, a fórmula do PROCV deve ser alterada, o que não está sendo muito assertivo. Para isso, voltei a me aventurar no VBA para tentar desenvolver um código para puxar as informações dos arquivos que estiverem salvos com a data mais recente dentro de suas respectivas pastas. Até achei alguns códigos prontos e modifiquei de acordo com as informações das minhas planilhas, mas não consegui fazer funcionar.

Alguém possui um código pronto para isso que preciso?

 

Muito obrigado!

[Alyson Ronnan Martins]

Boa tarde @thifreedom

Não sei se era isso que estava pensando mais esta ai um código que vê qual arquivo na pasta é o mais recente e depois faze a atualização do "vinculo" (comparando os arquivos vinculados com o nome "orçamento"):

Estou colocando também a planilha e pastas que eu fiz os teste:

Código:

Public Sub thifreedom()
Dim txtArquivo As String

ListaArquivos ActiveWorkbook.Path & "\LocalExterno"

txtArquivo = fnIdentificarRecente

sAtualizarLinks "ORÇAMENTO", txtArquivo

'MsgBox txtArquivo

End Sub

Sub ListaArquivos(tLocal As String)
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(tLocal)
With Sheets("Pasta")
    r = .Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    For Each FileItem In SourceFolder.Files
    
        .Cells(r, 1).Formula = FileItem.ParentFolder
        .Cells(r, 2).Formula = FileItem.Name
        .Cells(r, 3).Formula = FileItem.DateCreated
        .Cells(r, 3).NumberFormatLocal = "dd / mm / aaaa"
        .Cells(r, 4).Formula = FileItem.DateLastAccessed
        .Cells(r, 5).Formula = FileItem.DateLastModified
        .Cells(r, 5).NumberFormatLocal = "dd / mm / aaaa"
        r = r + 1
    Next
End With
End Sub

Function fnIdentificarRecente() As String
Dim DtRecente As Double
Dim r As Long
DtRecente = WorksheetFunction.Large(Sheets("Pasta").Range("E:E"), 1)
r = WorksheetFunction.Match(DtRecente, Sheets("Pasta").Range("E:E"), 0)

fnIdentificarRecente = Sheets("Pasta").Cells(r, "A").Value & "\" & _
                        Sheets("Pasta").Cells(r, "B").Value

End Function

Sub sAtualizarLinks(tContem As String, nLink As String)
Dim lLinks As Variant
lLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(lLinks) Then
    For i = 1 To UBound(lLinks)
        p = InStr(lLinks(i), tContem)
        If p > 1 Then
            ActiveWorkbook.ChangeLink lLinks(i), nLink, Type:=xlExcelLinks
        End If
    Next i
End If
End Sub

Arquivo: Planilhas e pastas de teste

[Alyson Ronnan Martins]

Teria que ter uma ideia de com o está usando o seu código porêm seria um procv  "normal" pesquisando valor de outra tabela. É o link seria atualizado sozinho com o Código.

[Alyson Ronnan Martins]

Show!

[thifreedom]

5 horas atrás, Alyson Ronnan Martins disse:

Boa tarde @thifreedom

Não sei se era isso que estava pensando mais esta ai um código que vê qual arquivo na pasta é o mais recente e depois faze a atualização do "vinculo" (comparando os arquivos vinculados com o nome "orçamento"):

Estou colocando também a planilha e pastas que eu fiz os teste:

Código:

Public Sub thifreedom()
Dim txtArquivo As String

ListaArquivos ActiveWorkbook.Path & "\LocalExterno"

txtArquivo = fnIdentificarRecente

sAtualizarLinks "ORÇAMENTO", txtArquivo

'MsgBox txtArquivo

End Sub

Sub ListaArquivos(tLocal As String)
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(tLocal)
With Sheets("Pasta")
    r = .Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    For Each FileItem In SourceFolder.Files
    
        .Cells(r, 1).Formula = FileItem.ParentFolder
        .Cells(r, 2).Formula = FileItem.Name
        .Cells(r, 3).Formula = FileItem.DateCreated
        .Cells(r, 3).NumberFormatLocal = "dd / mm / aaaa"
        .Cells(r, 4).Formula = FileItem.DateLastAccessed
        .Cells(r, 5).Formula = FileItem.DateLastModified
        .Cells(r, 5).NumberFormatLocal = "dd / mm / aaaa"
        r = r + 1
    Next
End With
End Sub

Function fnIdentificarRecente() As String
Dim DtRecente As Double
Dim r As Long
DtRecente = WorksheetFunction.Large(Sheets("Pasta").Range("E:E"), 1)
r = WorksheetFunction.Match(DtRecente, Sheets("Pasta").Range("E:E"), 0)

fnIdentificarRecente = Sheets("Pasta").Cells(r, "A").Value & "\" & _
                        Sheets("Pasta").Cells(r, "B").Value

End Function

Sub sAtualizarLinks(tContem As String, nLink As String)
Dim lLinks As Variant
lLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(lLinks) Then
    For i = 1 To UBound(lLinks)
        p = InStr(lLinks(i), tContem)
        If p > 1 Then
            ActiveWorkbook.ChangeLink lLinks(i), nLink, Type:=xlExcelLinks
        End If
    Next i
End If
End Sub

Arquivo: Planilhas e pastas de teste

 

Show cara!! Obrigado pela disposição em ajudar!

Como você associaria isso a um comando de procv/vlookup?

 

 

[thifreedom]

40 minutos atrás, Alyson Ronnan Martins disse:

Teria que ter uma ideia de com o está usando o seu código porêm seria um procv  "normal" pesquisando valor de outra tabela. É o link seria atualizado sozinho com o Código.

 

AHHH agora peguei a lógica. Funcionou certinho! Salvou demais, muito muito muito obrigado!!!