- 16 Fev 2022 às 13:40
#69196
Olá! gostaria de saber como fazer para restringir a importação de apenas dois registros do sped ?
O código vba que estou utilizando importa todos os registros.
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
