Notifications
Clear all

Mensagem "Arquivo não Encontrado"

10 Posts
3 Usuários
0 Reactions
1,160 Visualizações
(@luizhcosta)
Posts: 0
New Member
Topic starter
 

Olá,

Gostaria de exibir uma mensagem "Arquivo não Encontrado" para o código abaixo. Esse código importa o conteúdo do arquivo texto que tem seu nome relacionado na coluna "C" da planilha "contrato". Ocorre que, embora haja um nome na coluna "C", pode ser que este nome, que se refere a um arquivo, não esteja do diretório.

Código:

Public Sub ImportarArqText)

    Dim NomeArquivo As String
    Dim Caminho As String
        
    Dim wshContratos As Worksheet
    Dim rngCell As Range
    Dim rngMyArquivos As Range
    Dim celDestino
    
    'definimos o nome da aba
    Set wshContratos = Worksheets("Contratos")
    
    'Definimos o Range com Dados até a ultima linha preenchida
    Set rngMyArquivos = wshContratos.Range("c2:c" & Range("c" & Rows.Count).End(xlUp).Row)
       
    'Definimos o caminho no mesmo local do arquivo Controle.xls
    Caminho = ActiveWorkbook.Path & ""
    
    'Loop em cada celula no Range
    For Each rngCell In rngMyArquivos
        
        'Definimos a celula para inserir o texto
        celDestino = rngCell.Offset(0, 2).Address(0, 0)
        
        'Nome de cada arquivo
        NomeArquivo = rngCell & ".txt"
             
        'Abre o arquivo para leitura
        Open Caminho & NomeArquivo For Input As #1
            
            'Inseri o conteudo do arquivo na celula correspondente ao arquivo
            Range(celDestino).Value = Input$(LOF(1), 1)
            
            'Fecha o arquivo Texto
            Close #1
            
    Next rngCell
        
    ActiveSheet.Range("A:O").Columns.AutoFit
       
End Sub

Obrigado.

 
Postado : 11/03/2016 11:21 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

O jeito mais fácil, usando FileSystemObject é:
(Adapte para sua necessidade)

Se quiser ver se um arquivo existe:

    
    If VBA.CreateObject("Scripting.FileSystemObject").FileExists("C:PastaPastaDiretorioteste.txt") Then
    End If

Se quiser ver se um arquivo não existe:

    If Not VBA.CreateObject("Scripting.FileSystemObject").FileExists("C:PastaPastaDiretorioteste.txt") Then
    End If
 
Postado : 11/03/2016 11:32 am
(@luizhcosta)
Posts: 0
New Member
Topic starter
 

Olá Fernando,

VBA não é meu forte. Olhando suas sugestões elas buscam identificar com o nome no código a sua existência. No código que postei esse nome está nas células da coluna "C", sem inserí-los no código. Você poderia alterar o código para esse modelo ?

Valeu.

 
Postado : 12/03/2016 3:38 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Luiz

Movi teu tópico para Macros & VBA que é o assunto da tua dúvida.

[]s

Patropi - Moderador

 
Postado : 12/03/2016 7:36 pm
(@trindade)
Posts: 0
New Member
 

Boa noite, igormdiniz.

Cria uma função pra verificar se o caminho existe
Depois chama essa função para verificar o caminho +-:

' FUNCAO VERIFICA SE CAMINHO EXISTE
Function CaminhoExiste(sCaminho As String) As Boolean

    If Dir(sCaminho) = vbNullString Then
        CaminhoExiste = False
    Else
        CaminhoExiste = True
    End If
    
End Function

Public Sub ImportarArqText)

    Dim NomeArquivo As String
    Dim Caminho As String
        
    Dim wshContratos As Worksheet
    Dim rngCell As Range
    Dim rngMyArquivos As Range
    Dim celDestino
    
    'definimos o nome da aba
    Set wshContratos = Worksheets("Contratos")
    
    'Definimos o Range com Dados até a ultima linha preenchida
    Set rngMyArquivos = wshContratos.Range("c2:c" & Range("c" & Rows.Count).End(xlUp).Row)
       
    'Definimos o caminho no mesmo local do arquivo Controle.xls
    Caminho = ActiveWorkbook.Path & ""
    
    'Loop em cada celula no Range
    For Each rngCell In rngMyArquivos
        
        'Definimos a celula para inserir o texto
        celDestino = rngCell.Offset(0, 2).Address(0, 0)
        
        'Nome de cada arquivo
        NomeArquivo = rngCell & ".txt"
		
		If CaminhoExiste(NomeArquivo) then
             
			'Abre o arquivo para leitura
			Open Caminho & NomeArquivo For Input As #1
				
				'Inseri o conteudo do arquivo na celula correspondente ao arquivo
				Range(celDestino).Value = Input$(LOF(1), 1)
				
				'Fecha o arquivo Texto
				Close #1
				
		Else
		
			Msgbox "Arquivo não Encontrado"
		
		End if
            
    Next rngCell
        
    ActiveSheet.Range("A:O").Columns.AutoFit
       
End Sub
 
Postado : 12/03/2016 10:40 pm
(@luizhcosta)
Posts: 0
New Member
Topic starter
 

Olá igormdiniz,

Executei sua sugestão, mas exibe a mensagem mesmo existindo o caminho. O objetivo é exibir a ausência do arquivo ao invés do caminho. Claro que o primeiro passo seria verificar o local (caminho) onde o arquivo deveria estar.

Na coluna "C" existe uma relação, o codigo que postei executa a tarefa corretamente, acontece que eventualmente um nome de arquivo desta relação pode não estar presente no caminho especificado. Minha idéia é, ao não encontrar o arquivo o excel exiba a mensagem "Arquivo Não Encontrado" e permita continuar a importação ou interromper.

É isso. Obrigado.

 
Postado : 14/03/2016 6:19 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Fica assim:

Public Sub ImportarArqText)

    Dim NomeArquivo As String
    Dim Caminho As String
        
    Dim wshContratos As Worksheet
    Dim rngCell As Range
    Dim rngMyArquivos As Range
    Dim celDestino
    
    'definimos o nome da aba
    Set wshContratos = Worksheets("Contratos")
    
    'Definimos o Range com Dados até a ultima linha preenchida
    Set rngMyArquivos = wshContratos.Range("c2:c" & Range("c" & Rows.Count).End(xlUp).Row)
       
    'Definimos o caminho no mesmo local do arquivo Controle.xls
    Caminho = ActiveWorkbook.Path & ""
    
    'Loop em cada celula no Range
    For Each rngCell In rngMyArquivos
        
        'Definimos a celula para inserir o texto
        celDestino = rngCell.Offset(0, 2).Address(0, 0)
        
        'Nome de cada arquivo
        NomeArquivo = rngCell & ".txt"

        If VBA.CreateObject("Scripting.FileSystemObject").FileExists(Caminho & NomeArquivo) Then

             
        'Abre o arquivo para leitura
            Open Caminho & NomeArquivo For Input As #1
            
            'Inseri o conteudo do arquivo na celula correspondente ao arquivo
            Range(celDestino).Value = Input$(LOF(1), 1)
            
            'Fecha o arquivo Texto
            Close #1
        End If            
    Next rngCell
        
    ActiveSheet.Range("A:O").Columns.AutoFit
       
End Sub
 
Postado : 14/03/2016 7:05 am
(@luizhcosta)
Posts: 0
New Member
Topic starter
 

Olá Fernando,

Executei sua sugestão e ao contrário do código original, caso algum arquivo da relação esteja ausente na pasta, a importação prossegue sem nenhum alerta.
Essa importação será inserida em evento de abertura de arquivo. Pensei que seria interessante o alerta no caso da ausência de qualquer arquivo. Outra percepção que tive foi que, ao ser executado novamente o código não "limpa" os textos importados, o que seria recomendável também.
Acho que isso resolveria toda a questão.

Obrigado.

 
Postado : 14/03/2016 8:41 am
(@trindade)
Posts: 0
New Member
 

Quanto ao alerta, você chegou tentar colocar um else no código?
Visto que é um ciclo de if que o fernando.fernandes montou.

Ficaria assim:

Public Sub ImportarArqText)

    Dim NomeArquivo As String
    Dim Caminho As String
        
    Dim wshContratos As Worksheet
    Dim rngCell As Range
    Dim rngMyArquivos As Range
    Dim celDestino
    
    'definimos o nome da aba
    Set wshContratos = Worksheets("Contratos")
    
    'Definimos o Range com Dados até a ultima linha preenchida
    Set rngMyArquivos = wshContratos.Range("c2:c" & Range("c" & Rows.Count).End(xlUp).Row)
       
    'Definimos o caminho no mesmo local do arquivo Controle.xls
    Caminho = ActiveWorkbook.Path & ""
    
    'Loop em cada celula no Range
    For Each rngCell In rngMyArquivos
        
        'Definimos a celula para inserir o texto
        celDestino = rngCell.Offset(0, 2).Address(0, 0)
        
        'Nome de cada arquivo
        NomeArquivo = rngCell & ".txt"

        If VBA.CreateObject("Scripting.FileSystemObject").FileExists(Caminho & NomeArquivo) Then

             
        'Abre o arquivo para leitura
            Open Caminho & NomeArquivo For Input As #1
            
            'Inseri o conteudo do arquivo na celula correspondente ao arquivo
            Range(celDestino).Value = Input$(LOF(1), 1)
            
            'Fecha o arquivo Texto
            Close #1
        Else
            Msgbox "Arquivo não Encontrado"
        End If            
    Next rngCell
        
    ActiveSheet.Range("A:O").Columns.AutoFit
       
End Sub

Acho que esse detalhe resolve o problema do " Alerta "

 
Postado : 14/03/2016 8:57 am
(@luizhcosta)
Posts: 0
New Member
Topic starter
 

Ótimo,

Era isso que esperava.

Obrigado ao Fernando também pela ajuda.

 
Postado : 14/03/2016 9:46 am