Notifications
Clear all

Comando .LookIn

6 Posts
2 Usuários
0 Reactions
940 Visualizações
(@enila)
Posts: 0
New Member
Topic starter
 

Olá
Gostaria da ajuda de algum de vocês para me informar o porquê do comando .LookIn não está retornando o caminho especificado, pois o caminho existe, mas ao depurar o valor dessa variável só informa que a variável não foi especificada.

Sub atualizaMETA2015()
'***************************

Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim sheetCount As Integer
Dim strDir, strFileType, nomeProjeto As String

Dim ss As SearchScope

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
.NewSearch
.SearchSubFolders = True
'Change path to suit
.LookIn = "C:Usersto9zDocumentsTeste"
strDir = .LookIn
.FileType = msoFileTypeExcelWorkbooks
'Optional filter w ith wildcard
.Filename = "*-custos.xls"
strFileType = .Filename

 
Postado : 15/01/2015 8:58 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Apesar de não ter postado seu código por inteiro e muito menos seu anexo, então use no topo do módulo a opção

Option Explicit

http://www.homeandlearn.org/option_explicit.html

No mais declare todas as variáveis!!

Att

 
Postado : 15/01/2015 10:24 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Como disse o colega Alexandre, a rotina está incompleta, o erro relatado aparentemente não tem haver com o comando.
Não entendi o motivo de atribuir a variável o caminho depois de "utiliza-lo"; o normal seria algo assim:

Sub atualizaMETA2015()
'***************************

Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim sheetCount As Integer
Dim strDir As String, strFileType As String, nomeProjeto As String

Dim ss As SearchScope


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
'Atribui as variaveis 
strDir = "C:Usersto9zDocumentsTeste"
strFileType = "*-custos.xls"

On Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
.NewSearch
.SearchSubFolders = True
'Change path to suit
.LookIn = strDir
.FileType = msoFileTypeExcelWorkbooks
'Optional filter with wildcard
.Filename = strFileType

Porem sem saber a rotina completa e o objetivo fica muito dificil uma ajuda.
A rotina abaixo procura numa pasta qualquer arquivo xls

Sub tt()
Dim i As Integer
With Application.FileSearch
    .NewSearch
    .LookIn = "C:Temp"
    .SearchSubFolders = True
    .Filename = "*.xls*"
    .MatchAllWordForms = True
    .FileType = msoFileTypeAllFiles
    If .Execute() > 0 Then
        MsgBox "There were " & .FoundFiles.Count & _
        " file(s) found."
        For i = 1 To .FoundFiles.Count
            MsgBox .FoundFiles(i)
        Next i
    Else
        MsgBox "There were no files found."
    End If
End With
End Sub
 
Postado : 15/01/2015 10:46 am
(@enila)
Posts: 0
New Member
Topic starter
 

Olá amigos
De antemão agradeço a atenção.
Ano passado usei esse mesmo código e funcionou normalmente, esse ano é que está dando a mensagem que não encontra o caminho, por isso não tinha copiado o código inteiro, mas copiei agora para vocês verificarem.
Este código tem como objetivo ler um ou mais arquivos que se encontra na pasta "C:Usersto9zDocumentsTeste" e para cada arquivo encontrado ele grava as informações obtidas de outro arquivo.
Segue o código completo.

Sub atualizaMETA2015()
'***************************

Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim sheetCount As Integer
Dim strDir, strFileType, nomeProjeto As String

Dim ss As SearchScope

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
.NewSearch
.SearchSubFolders = True
'Change path to suit
.LookIn = "C:Usersto9zDocumentsTeste"
strDir = .LookIn
.FileType = msoFileTypeExcelWorkbooks
'Optional filter w ith wildcard
.Filename = "*-custos.xls"
strFileType = .Filename
MsgConfirm = MsgBox("A macro executará as modificações a partir dos seguintes critérios:" & Chr(13) & Chr(13) & strDir & Chr(13) & Chr(13) & "Com a seguinte configuração de busca:" & Chr(13) & Chr(13) & strFileType, vbOKCancel)
MsgBox (.Execute & " arquivos encontrados. Clique OK para iniciar a operação.")
If MsgConfirm = 1 Then
If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)

wbResults.Activate
ActiveSheet.Unprotect
Sheets("PROJETO").Select
'*************** DO YOUR CODE HERE

'Procedimento que adiciona as formulas para buscar valores da META 2013
'Ver caminho do arquivo de Meta

'Buscar valores via PROCV na planilha META
'localizada em \petrobras.bizPetrobrasUO-SEALUO-SEAL_ATP-ST_PRGCRESERVADAProjetosBase CustosHistorico
'a planilha META deve estar aberta quando rodar esta MACRO

Range("CT5").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERR(VLOOKUP(LEFT(R1C2,6),'[Meta.xls]META 2014'!R2C1:R150C16,R[-2]C[-53]+2,FALSE)),0,VLOOKUP(LEFT(R1C2,6),'[Meta.xls]META 2014'!R2C1:R150C16,R[-2]C[-53]+2,FALSE))"
Range("CT5").Select
Selection.AutoFill Destination:=Range("CT5:DE5"), Type:=xlFillValues
Range("CT5:DE5").Select

'Formula de soma da META 2014
Range("DF5").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
Range("DF6").Select

'Copiar e colar como valores para remover as formulas
Range("CT5:DE5").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

'Apagar META 2015
Range("CG5:CR5").Select
Selection.Clear

'*************** END CODE
Sheets("MENU").Select
'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:= _
' False, AllowFiltering:=True
wbResults.Close SaveChanges:=True
Next lCount
End If
End If
End With
On Error GoTo 0
'MsgBox (Err.Description & " : " & Err.Number)
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

 
Postado : 15/01/2015 11:54 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde Enila

Seja bem-vindo(a) ao fórum!

Movi teu tópico para VBA & Macros, que é o assunto da tua dúvida, pois o local onde vc havia postado é exclusivo somente para a apresentação dos novos usuários do fórum.

Por enquanto vou deixar o tópico sendo mostrado nos 2 locais.

[]s

Patropi - Moderador

 
Postado : 15/01/2015 11:58 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

A rotina "rodou" normalmente sem erro algum.
Mesmo não encontrando o diretório, nessa condição na segunda mensagem indica que não encontrou registros e encerra a rotina.
Alterando para um diretório existente em meu equipamento, acha os arquivos e abre normalmente, só não "passei" pela aplicação de formula/detalhes de planilha, pois não tenho os layouts e detalhes das mesmas.
Experimente executar a rotina porem com as linhas de tratamento de erro (On Error) e "congelamento" (Application...) comentadas, No editor VBE, tecle F8 e vá linha a linha para tentar descobrir o momento real do erro.
Modo como utilizei/testei

Sub atualizaMETA2015()
'***************************
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim lCount As Long
Dim sheetCount As Integer
Dim strDir As String, strFileType As String, NomeProjeto As String
Dim MsgConfirm As Integer

strDir = "D:ReinaldoArquivos GrupoExcelExemplos" '"C:Usersto9zDocumentsTeste"
strFileType = "*custo*.xls"

'Application.ScreenUpdating = False
'Application.DisplayAlerts = False
'Application.EnableEvents = False

'On Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
    .NewSearch
    .SearchSubFolders = True
    'Change path to suit
    .LookIn = strDir
    .FileType = msoFileTypeExcelWorkbooks
    'Optional filter w ith wildcard
    .Filename = strFileType
    MsgConfirm = MsgBox("A macro executará as modificações a partir dos seguintes critérios:" & Chr(13) & Chr(13) & strDir & Chr(13) & Chr(13) & "Com a seguinte configuração de busca:" & Chr(13) & Chr(13) & strFileType, vbOKCancel)
    MsgBox (.Execute & " arquivos encontrados. Clique OK para iniciar a operação.")
    If MsgConfirm = 1 Then
        If .Execute > 0 Then 'Workbooks in folder
            For lCount = 1 To .FoundFiles.Count 'Loop through all
            'Open Workbook x and Set a Workbook variable to it
            Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
            
            wbResults.Activate
            ActiveSheet.Unprotect
            GoTo aqui
            Sheets("PROJETO").Select
            '*************** DO YOUR CODE HERE
            
            'Procedimento que adiciona as formulas para buscar valores da META 2013
            'Ver caminho do arquivo de Meta
            
            'Buscar valores via PROCV na planilha META
            'localizada em \petrobras.bizPetrobrasUO-SEALUO-SEAL_ATP-ST_PRGCRESERVADAProjetosBase CustosHistorico
            'a planilha META deve estar aberta quando rodar esta MACRO
            Range("CT5").Select
            ActiveCell.FormulaR1C1 = _
            "=IF(ISERR(VLOOKUP(LEFT(R1C2,6),'[Meta.xls]META 2014'!R2C1:R150C16,R[-2]C[-53]+2,FALSE)),0,VLOOKUP(LEFT(R1C2,6),'[Meta.xls]META 2014'!R2C1:R150C16,R[-2]C[-53]+2,FALSE))"
            Range("CT5").Select
            Selection.AutoFill Destination:=Range("CT5:DE5"), Type:=xlFillValues
            Range("CT5:DE5").Select
            
            'Formula de soma da META 2014
            Range("DF5").Select
            ActiveCell.FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
            Range("DF6").Select
            
            'Copiar e colar como valores para remover as formulas
            Range("CT5:DE5").Select
            Selection.Copy
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Application.CutCopyMode = False
            
            'Apagar META 2015
            Range("CG5:CR5").Select
            Selection.Clear
            
            '*************** END CODE
            Sheets("MENU").Select
            'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:= _
            ' False, AllowFiltering:=True
aqui:
            wbResults.Close SaveChanges:=True
            Next lCount
        End If
    End If
End With
'On Error GoTo 0
'MsgBox (Err.Description & " : " & Err.Number)
'Application.ScreenUpdating = True
'Application.DisplayAlerts = True
'Application.EnableEvents = True
End Sub
 
Postado : 15/01/2015 12:49 pm