Importar arquivo VBA

'################################################################################################################
' Esta função serve para abrir o OpenDialogFile
'
' @author  Wanderlei Hüttel <wanderlei dot huttel at gmail dot com>
' @name    fnAbrirArquivo
' @param   'string'      strFileName      Nome do arquivo/diretório inicial
' @param   'integer'     iPath            Caminho padrão inicial
' @return  'string'                       String com o caminho do arquivo
Public Function fnAbrirArquivo(sFileName As String, Optional ByVal iPath As Integer = 0) As String
   Dim fd As Office.FileDialog
   Dim vrtSelectedItem As Variant
   Set fd = Application.FileDialog(msoFileDialogFilePicker)

    ' Define o caminho padrão para salvar o arquivo'
    ' Desktop do usuário
    If (iPath = 1) Then
       sPath = Environ$("USERPROFILE") & "\Desktop\" & sFileName
    ' Caminho especifico
    ElseIf (iPath = 2) Then
       sPath = sFileName
    ' Raiz da planilha
    Else
       sPath = ActiveWorkbook.Path & "\" & sFileName
    End If

    With fd
        .AllowMultiSelect = False
        .Filters.Add "Todos os Arquivos", "*.*", 1
        .Filters.Add "Arquivos Texto", "*.csv", 1
        .Filters.Add "Arquivos Texto", "*.txt", 1
        .InitialFileName = sPath

        If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
                sPath = vrtSelectedItem 'Caminho e nome do arquivo
                fnAbrirArquivo = CStr(sPath)
                Next vrtSelectedItem
        Else
           fnAbrirArquivo = ""
        End If
    End With
    Set fd = Nothing
End Function

'################################################################################################################
' Esta função serve para remover múltiplos espaços de String
'
' @author  Wanderlei Hüttel <wanderlei dot huttel at gmail dot com>
' @name    fnDeleteMultipleSpaces
' @param   'string'      sString          String com espaços
' @return  'string'                       String sem múltiplos espaços
Public Function fnDeleteMultipleSpaces(sString As String) As String
  sString = Replace(sString, vbTab, " ")
  Do While InStr(sString, "  ") > 0
    sString = Replace(sString, "  ", " ")
  Loop
  fnDeleteMultipleSpaces = sString
End Function

'########## Função Importar Arquivo ##########
Public Sub ImportarArquivo()
   Dim linha As String

   Temp.Range("A1:IV65536").ClearContents
   Temp.Range("A1:IV65536").Font.Name = "Courier New"
   Temp.Range("A1:IV65536").Font.Size = 8

    'Caixa de seleção de arquivo
    arquivo = fnAbrirArquivo("")

    ' Se arquivo for vazio para a macro
    If arquivo = "" Then
       Exit Sub
    End If

    ' Abre o arquivo a ser importado
    Open arquivo For Input As #1

     ' Looping pelas linhas do arquivo
     i = 2
     j = 0

     Temp.Range("G:I").NumberFormat = "#,##0.00"
     Temp.Range("E:F").NumberFormat = "@"
     Do While Not EOF(1)
        Line Input #1, linha

        ' Remove múltiplos espaços e substitui TAB por espaço
        linha = Trim(fnDeleteMultipleSpaces(linha))

        If (j = 3017) Then
            x = 1
        End If

        ' Remove o campo Valor Total do Cliente
        If (InStr(1, linha, "Vl. Total do Cliente", 1)) Then
           Line Input #1, linha
           linha = Trim(fnDeleteMultipleSpaces(linha))
           i = i - 1
           Temp.Cells(i, 1) = ""
        End If

        ' Remove o campo Valor Total
        If InStr(1, linha, "Vl. Total ", 1) Then
           Line Input #1, linha
           linha = Trim(fnDeleteMultipleSpaces(linha))
           i = i - 1
           Temp.Cells(i, 1) = ""
        End If

        'Pega o código e nome do cliente
        If InStr(1, linha, "Cliente :", 1) Then
          cliente = Trim(Replace(linha, "Cliente :", ""))
          cliente_aux = Split(cliente, "-")
          codigo_cliente = Trim(cliente_aux(0))
          nome_cliente = Trim(cliente_aux(1))
          Line Input #1, linha
          linha = Trim(fnDeleteMultipleSpaces(linha))
        End If


        'Se a linha não for vazia
        If (Len(Trim((linha))) > 0 And j > 8) Then

            If (Len(Trim((linha))) > 40) Then
                reg = Split(linha, " ")
                filial = reg(0)
                lancamento = Replace(reg(1), ".", "")
                documento = reg(2)
                parcela_aux = Split(reg(3), "/")
                parcela = parcela_aux(1)
                data_emissao = reg(4)
                data_vencimento = reg(5)
                valor_parcela = reg(6)
                valor_recebido = reg(7)
                valor_saldo = reg(8)

                Temp.Cells(i, 1) = filial
                Temp.Cells(i, 2) = lancamento
                Temp.Cells(i, 3) = documento
                Temp.Cells(i, 4) = parcela
                Temp.Cells(i, 5) = data_emissao
                Temp.Cells(i, 6) = data_vencimento
                Temp.Cells(i, 7) = CDbl(valor_parcela)
                Temp.Cells(i, 8) = CDbl(valor_recebido)
                Temp.Cells(i, 9) = CDbl(valor_saldo)
                Temp.Cells(i, 10) = codigo_cliente
                Temp.Cells(i, 11) = nome_cliente
            End If

           i = i + 1
        End If
        j = j + 1
     Loop

    ' Fecha o arquivo
    Close #1

    Range("A1").Select
    retorno = MsgBox("Arquivo Importado Com Sucesso !!!", vbInformation)

End Sub