Vba - quebrar arquivo em parte menores

Este documento tem como objetivo mostrar como podemos quebrar um arquivo grande em parte menores utilizando o VBA.

Para isso, vá na janela do VBA e no menu "Ferramentas", clique no item "Referências". Procure e marque a checkbox "Microsoft Scripting Runtime", clique em "Ok".

textbox: txtCaminhoCompletoArq textbox: txtCaminhoCompletoArqMenores textbox: txtQtde botão de comando: cmdQuebra

O evento click do botão deve ficar assim:

Private Sub cmdQuebra_Click()
'
' Importa o arquivo txt grande e coloca as partes dele em arquivos diferentes
'

Dim sArq As String
Dim sDir As String
Dim TextLine As String
Dim MaxLinhas As Long
Dim k As Long

Dim fso As FileSystemObject
Dim fArq As TextStream
Dim fTest As File

If MsgBox("Confirma importação do arquivo txt?", vbQuestion + vbYesNo, "Confirmando") = vbNo Then
Exit Sub
End If

sArq = Me.txtCaminhoCompletoArq sDir = Me.txtCaminhoCompletoArqMenores

MaxLinhas = txtQtde ''''''''''' indTab = 1

Set fso = New FileSystemObject
Set fArq = fso.CreateTextFile(sDir & "\sub" & Format(indTab, "000") & ".txt", True)

Open sArq For Input As #1
' Faz o loop até o fim do arquivo.
Do While Not EOF(1)
' Lê a linha para a variável.
Line Input #1, TextLine
' Imprima na janela Immediate.
'Debug.Print TextLine
' Põe no arquivo de saída fArq.WriteLine TextLine k = k + 1
If k = MaxLinhas Then 'quebra arquivo com MaxLinhas linhas (mude este valor na caixa de texto se quiser 1000, por exemplo) indTab = indTab + 1 fArq.Close Set fArq = fso.CreateTextFile(sDir & "\sub" & Format(indTab, "000") & ".txt", True) k = 0
End If
Loop
Close #1 fArq.Close 'testa se o último arquivo é vazio
Set fTest = fso.GetFile(sDir & "\sub" & Format(indTab, "000") & ".txt")
If fTest.Size = 0 Then fTest.Delete Set fTest = Nothing
End If

Set fArq = Nothing
Set fso = Nothing
MsgBox "Arquivo importado com sucesso!", vbExclamation, "Pronto"
End