Página 1 de 1

Desenvolver uma macro

Enviado: Qui Jan 26, 2012 7:08 am
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 :!:

Re: Desenvolver uma macro

Enviado: Sex Jan 27, 2012 10:58 am
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