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

Desenvolver uma macro

Ponto de encontro entre aqueles que precisam e fornecem soluções baseadas no Microsoft Excel e VBA. Precisa de uma solucão em VBA? É um consultor ou programador independente? Esse é o lugar!
padunic
Acabou de chegar
Acabou de chegar
Mensagens: 1
Registrado em: Qui Jan 26, 2012 7:03 am

Desenvolver uma macro

Mensagem por padunic »

Oi,

seguinte preciso que seja desenvolvida uma macro que busque em uma pasta arquivos textos que são colocados todos os dias e verifique nestes arquivos se existe um número específico e autalize uma planilha dizendo Ok onde tem este número e na frente quantas foram encontradas.
Os arquivos textos não tem cabeçalho.

Abs.

Padunic
padunic@ig.com.br :!:


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.


chamojo
Colaborador
Colaborador
Mensagens: 20
Registrado em: Ter Jan 10, 2012 12:23 pm
Contato:

Re: Desenvolver uma macro

Mensagem por chamojo »

Oi
Não consegui anexar o arquivo, ai vai.


Private Sub CommandButton1_Click()

Dim fs, f, f1, fc, vdir

vdir = "c:\teste\"
vdir = "C:\_Equipe\_Ricardo\comodato\2012\janeiro\lixo\"
vnr_procurar = "1234"


Sheets(1).Columns("A:A").Select
Selection.ClearContents

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(vdir)
Set fc = f.Files

linha = 1
Sheets(1).Cells(linha, 1) = "Arquivo"
Sheets(1).Cells(linha, 2) = "Nr Vezes"
For Each f1 In fc
If InStr(UCase(f1.Name), "TQS_SINAF_D") > 0 And InStr(UCase(f1.Name), ".TXT") > 0 Then

vNome_Arq_Completo = vdir + f1.Name

Set oSistemaArquivo = CreateObject("Scripting.FileSystemObject")
Set arquivo = oSistemaArquivo.OpenTextFile(vNome_Arq_Completo, 1, False, -2)

vQtde = 0

Do While arquivo.AtEndOfStream <> True
If InStr(arquivo.ReadLine, vnr_procurar) > 0 Then
vQtde = vQtde + 1
End If
Loop
oSistemaArquivo = Null
arquivo = Null

linha = linha + 1
Sheets(1).Cells(linha, 1) = f1.Name
Sheets(1).Cells(linha, 2) = vQtde

End If
Next


End Sub

Boa sorte
Eduardo


Responder