Este fórum está sendo desativado

[pabloviana]

Olá, sou novo no mundo do vba, e eu vi aqui nesse mesmo fórum que há a macro para importar o SPED CONTRIBUIÇÔES, porém para o meu trabalho de análise específico, apenas o registro C100, C170, C175 e o C870 me interessam, por isso a macro que consegui encontrar não atende aos critérios, já que importa todo o arquivo do SPED.

Segue a macro que importa todo o arquivo do SPED CONTRIBUIÇÕES:

Dim vrTemp() As String
Function ExisteSheet(nome As String) As Boolean
Dim Sh As Worksheet
On Error Resume Next
Set Sh = Worksheets(nome)
If Sh Is Nothing Then ExisteSheet = False Else ExisteSheet = True
Set Sh = Nothing
End Function

Sub importarTxt()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.DisplayStatusBar = False

Dim Tempo As Double
Tempo = Now()

Dim strArquivo As Office.FileDialog
Dim strLinhaTexto As String
Dim intContItens As Integer, x As Integer

Set strArquivo = Application.FileDialog(msoFileDialogOpen)

With strArquivo
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Arquivos TXT", "*.txt"
.Title = "Selecione um ou mais arquivos"
.Show
End With
intContItens = strArquivo.SelectedItems.Count
If intContItens = 0 Then
MsgBox "Nenhum arquivo selecionado"
Exit Sub
End If
'abre o arquivo texto para leitura.
'Altere para o caminho e nome de seu arquivo
For x = 1 To intContItens
Open strArquivo.SelectedItems(x) For Input As #1

Do While Not EOF(1)
Line Input #1, strLinhaTexto
vrTemp = Split(strLinhaTexto, "|")
If ExisteSheet(vrTemp(1)) = True Then
incluinaplan (vrTemp(1))
Else
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = vrTemp(1)
incluinaplan (vrTemp(1))
End If
Loop
Close #1 'fecha o arquivo texto
Next
Sheets(1).Select

MsgBox "Concluido"
MsgBox Now() - Tempo
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.DisplayStatusBar = True

End Sub
Private Sub incluinaplan(ByVal strNome As String)
Dim intLinhaFim As Long, y As Long
intLinhaFim = Sheets(strNome).Cells(Rows.Count, 1).End(xlUp).Row + 1
With Sheets(strNome)
For y = 1 To UBound(vrTemp)
.Cells(intLinhaFim, y) = "'" & vrTemp(y)
Next
End With
End Sub

IMPORTAR .TXT DO COMPLEXO SPED NO EXCEL#54158
Por JulioMangilli - 28 Abr 2020 às 08:44Posts
Quase esqueci, todos os créditos vão para o incrível Reinaldo que ajuda aqui como no site do Tomaz. Grande abraço a esse profissional.

IMPORTAR .TXT DO COMPLEXO SPED NO EXCEL#54159
Por JulioMangilli - 28 Abr 2020 às 08:46Posts
Caso precise puxar um campo especifico e vai dar um erro por causa da assinatura do SPED que consegue sanar com essa programação.


' funcao para importar sómente o campo C100 ----------'
Do While Not EOF(1)
Line Input #1, strLinhaTexto
vrTemp = Split(strLinhaTexto, "|")

'Alteração do código começa aqui
If vrTemp(1) = "9999" Then
Exit Do
End If
'Fim da alteração do código

If VarType(strLinhaTexto) <> 1 Then
If vrTemp(1) = "C100" Then 'Verifica se o codigo corresponde ao esperado
If ExisteSheet(vrTemp(1)) = True Then
incluinaplan (vrTemp(1))
Else
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = vrTemp(1)
incluinaplan (vrTemp(1))
End If
End If
End If
Loop
'------------------------------------------------------'