Notifications
Clear all

vba para copiar arquivo texto e salvar em nova planilha excel... com ela ja fechada

1 Posts
1 Usuários
0 Reactions
734 Visualizações
(@Anônimo)
Posts: 0
Topic starter
 

Bom dia

o código abaixo estou usando para abrir uma arquivo texto e puxar para excel.

queria gerar estes dados importados em uma nova planilha excel, porém, com ela salva em um diretório e já fechada, mas não estou conseguindo.

ja olhei woorkbooks mas não consegui o código certo para criar esta palinha recebendo os dados importados e ja fechar a planilha.

sou novo no forum.

sou grato a todos.

Sub ImportarPlanilha()
  '
  ' ImportarPlanilha Macro
  ' Desenvolvido por Antenor. Importar arquivo de folha de pagamento
  '
  ' Atalho do teclado: Ctrl+Shift+I
  '
  Dim arquivo As String, texto As String, linhaTexto As String, NomeArquivo As String, Centavos As String
  Dim LinhaArquivo As Integer, LinhaExcel As Integer, Tamanho As Integer
  NomeArquivo = InputBox("Nome do arquivo para importar")
  arquivo = "c:\teste\" & NomeArquivo
  If NomeArquivo <> "" Then
    On Error GoTo MENSAGEM '... se não encontrar arquivo mostra mensagem
    Open arquivo For Input As #1
      LinhaArquivo = 0
      LinhaExcel = 1
      Do Until EOF(1)
        Line Input #1, linhaTexto
        Tamanho = 0
        If LinhaArquivo > 1 Then
          '...parte texto =
          If CInt(Mid(linhaTexto, 25, 4)) <> 0 Then
            Cells(LinhaExcel, 1).Value = CInt(Mid(linhaTexto, 25, 4)) '...agência
            Cells(LinhaExcel, 2).Value = Mid(linhaTexto, 37, 5) '...conta
            Cells(LinhaExcel, 3).Value = Mid(linhaTexto, 43, 1) '...digito verificador
            Cells(LinhaExcel, 4).Value = Mid(linhaTexto, 44, 49) '...nome
            Cells(LinhaExcel, 5).Value = Mid(linhaTexto, 198, 20) '...cpf
            Cells(LinhaExcel, 6).Value = "1" '...finalidade 1 salario
            '... identifica salário e adiciona virgula
            valor = Mid(linhaTexto, 105, 30)
            Tamanho = (Len(valor) - 2)
            Centavos = ("," & Right(valor, 2))
            vlr = CInt(Left(valor, Tamanho))
            Cells(LinhaExcel, 7).Value = CDec(vlr & Centavos)
          End If
          LinhaExcel = LinhaExcel + 1
        End If
        LinhaArquivo = LinhaArquivo + 1
      Loop
    Close #1
  End If
MENSAGEM:   MsgBox ("Arquivo não encontrado") '... não encontrou arquivo
End Sub

____________________

Editado pela Moderação. Motivo: Procure utilizar o botão Código (< >) sempre que for inserir código VBA ou Fórmulas.

 
Postado : 14/11/2022 1:01 pm