Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Buscar valor de uma célula de outro arquivo sem abri-lo

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
patrickão
Colaborador
Colaborador
Mensagens: 15
Registrado em: Ter Jul 01, 2014 9:35 pm

Buscar valor de uma célula de outro arquivo sem abri-lo

Mensagem por patrickão »

Olá Pessoal.

Estou tentando buscar o valor de uma célula de uma planilha do excel que pertence a outro arquivo. Gostaria de realizar isso sem precisar abrir tal arquivo. Busquei vários exemplos na internet e conseguir realizar de forma simples. Porém, fui adaptar para a minha necessidade que consiste em contar o numero de arquivos existente numa pasta, lista-los e retirar informações de células específicas.

No meu diretório tinha 4 arquivos. Porém quando eu rodo o programa, ele conta apenas d2, ou seja, a função Dir para de buscar as informações.
Quando eu comento ou excluo a linha (Valor = GetInfoFromClosedFile(myfolder, Dados, "Plan1", "A1") que é a função de buscar o valor de uma célula de outro arquivo o programa conta os arquivos corretamente.

Alguém pode me dizer o está de errado no código?

Sub Contar_Numero_de_Arquivos()
Dim MyFile As String, Sep As String, myfolder As String, cnt As Long, Names As Variant, NextRow As Long
Dim Valor As Variant, Dados As String

myfolder = "C:\Users\patrick\Desktop"
Sep = Application.PathSeparator
If Sep = "\" Then
MyFile = Dir(myfolder & Sep & "*.xls")

End If
NextRow = Application.CountA(Range("A:A")) + 1

'Msgbox com o Valor em A1
'MsgBox "O Valor em A1 - Plan1 é :- " & cValue

Do While MyFile <> ""
cnt = cnt + 1
Names = MyFile
Dados = MyFile
MyFile = Dir

Cells(NextRow, 1).Value = Names
NextRow = NextRow + 1 'Mover para a próxima linha

'Le o Valor da Célula espicificada
Valor = GetInfoFromClosedFile(myfolder, Dados, "Plan1", "A1")

Loop
MsgBox cnt

Columns("A").Delete
End Sub

Private Function GetInfoFromClosedFile(ByVal wbPath As String, _
wbName As String, _
wsName As String, _
cellRef As String) As Variant

Dim arg As String
GetInfoFromClosedFile = ""

If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"

If Dir(wbPath & "\" & wbName) = "" Then Exit Function

arg = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)

On Error Resume Next
GetInfoFromClosedFile = ExecuteExcel4Macro(arg)

End Function

Até Mais.


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
Reinaldo
Jedi
Jedi
Mensagens: 1537
Registrado em: Sex Ago 01, 2014 4:09 pm
Localização: Garça - SP / SCS - SP

Re: Buscar valor de uma célula de outro arquivo sem abri-lo

Mensagem por Reinaldo »

Não sei se ja avançou, mas segue uma possibilidade

Código: Selecionar todos

Sub Contar_Numero_de_Arquivos()
Dim myFile As String, myFolder As String, cnt As Long, NextRow As Long
Dim Valor As Variant

myFolder = "C:\Users\patrick\Desktop"
If Right(myFolder, 1) <> "\" Then myFolder = myFolder & "\"


NextRow = Application.CountA(Range("A:A")) + 1
'Verifica as planilhas existentes e escreve na atual
myFile = Dir(myFolder & "*.xls")
Do While myFile <> ""
Cells(NextRow, 1).Value = myFile
myFile = Dir
NextRow = NextRow + 1 'Mover para a próxima linha
cnt = cnt + 1
Loop

'Le o Valor da Célula espicificada e escreve naplanilha
For NextRow = 2 To cnt + 1
    myFile = Cells(NextRow, 1)
    Valor = GetInfoFromClosedFile(myFolder, myFile, "Plan1", "A1")
    Cells(NextRow, 2) = Valor
'Se for somente a soma do valor encontrado
If Not IsError(Valor) Then Total = Total + Valor
Next

MsgBox cnt
MsgBox Total
'Columns("A").Delete
End Sub


patrickão
Colaborador
Colaborador
Mensagens: 15
Registrado em: Ter Jul 01, 2014 9:35 pm

Re: Buscar valor de uma célula de outro arquivo sem abri-lo

Mensagem por patrickão »

Valeu pela Dica!!!

Abraço!!!


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder