Gerar TXT com nome de celula

2024 - VBA & Macros

Post Recente por Fernando Fernandes 9 anos atrás

4 Posts

2 Usuários

0 Reactions

1,007 Visualizações

RSS

vpeglow

(@vpeglow)

Posts: 88

Trusted Member

Topic starter

Boa tarde a todos,

eu uso o código abaixo para gerar TXT de uma paln que uso, porem eu queria que no me do arquivo ficasse o mesmo que esta aparecendo na célula A1 no momento que irei gerar.

Aguem poderia me ajudar?

Sub GerarBancoDeDados()
    Dim localGravacao As String
    Dim nomeArquivo As String
    Dim linhaGravar As String
    Dim ultLinha As Integer
    Dim ultColuna As Integer
    
    localGravacao = Environ("USERPROFILE") & "Desktop"
    nomeArquivo = "ERP Web" & "-" & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & " - " & Replace(Time, ":", ".") & ".txt"
    ultLinha = Sheets("Gerador TXT").Cells(Cells.Rows.Count, "A").End(xlUp).Row
    ultCol = Sheets("Gerador TXT").Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    
    'Abre o arquivo para gravação
    Open localGravacao & nomeArquivo For Output As #1
        For i = 1 To ultLinha
            For j = 1 To ultCol
                   'Concatena as colunas separando elas por ","
                   linhaGravar = linhaGravar & Sheets("Gerador TXT").Cells(i, j).Value & "|"
            Next j
            'Grava a linha no arquivo - As funções Left e Len são utilizadas para excluir a última virgula do texto
            Print #1, Left(linhaGravar, Len(linhaGravar) - 1)
            linhaGravar = ""
        Next i
    Close #1
    MsgBox "Importado sucesso.", vbInformation, "BD"
End Sub

Postado : 24/02/2016 12:05 pm

Fernando Fernandes

(@fernandofernandes)

Posts: 43750

Illustrious Member

Sub GerarBancoDeDados()
    Dim localGravacao As String
    Dim nomeArquivo As String
    Dim linhaGravar As String
    Dim ultLinha As Integer
    Dim ultColuna As Integer
    
    localGravacao = Environ("USERPROFILE") & "Desktop"
    nomeArquivo = [A1] & " - ERP Web" & "-" & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & " - " & Replace(Time, ":", ".") & ".txt"
    ultLinha = Sheets("Gerador TXT").Cells(Cells.Rows.Count, "A").End(xlUp).Row
    ultCol = Sheets("Gerador TXT").Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    
    'Abre o arquivo para gravação
    Open localGravacao & nomeArquivo For Output As #1
        For i = 1 To ultLinha
            For j = 1 To ultCol
                   'Concatena as colunas separando elas por ","
                   linhaGravar = linhaGravar & Sheets("Gerador TXT").Cells(i, j).Value & "|"
            Next j
            'Grava a linha no arquivo - As funções Left e Len são utilizadas para excluir a última virgula do texto
            Print #1, Left(linhaGravar, Len(linhaGravar) - 1)
            linhaGravar = ""
        Next i
    Close #1
    MsgBox "Importado sucesso.", vbInformation, "BD"
End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 24/02/2016 12:18 pm