Esqueceu sua senha? Você pode usar o mecanismo de lembrete neste link: Recuperar senha

Você receberá um link de reativação no email cadastrado.

Não recebeu o email? Lembre-se checar o Lixo Eletrônico.

Arquivos de Texto

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
fao17
Acabou de chegar
Acabou de chegar
Mensagens: 3
Registrado em: Seg Jun 10, 2019 7:10 pm

Arquivos de Texto

Mensagem por fao17 » Qui Ago 22, 2019 7:46 pm

Boa Noite.

Estou tentando adaptar o código abaixo conforme minha necessidade. No caso este código serve para ler um arquivo txt e transferir para uma planilha.
Quero alterar o código abaixo na linha ''LocaldoArquivo".
Ele menciona o exemplo com a instrução LocaldoArquivo = Application.GetOpenFilename() onde abre um mine explorer tendo a necessidade de chegar manualmente a pasta desejada.
Outro exemplo mencionado é LocaldoArquivo = "C:\LOCAL_DO_ARQUIVO\banco-de-dados.txt" onde pelo que entendi serve apenas para quando o nome do arquivo nunca é alterado.
Gostaria de saber se é possível abrir o mine explorer direto em uma pasta e sem o nome do arquivo desejado na instrução uma vez que diariamente é criado um arquivo com nome diferente.

Sub ImportarTexto ()
Dim LocaldoArquivo As String
Dim NumArquivo As Integer
Dim Dadosdetexto As String
Dim QuebraLinha as Variant
Dim UltLinha as Integer
Dim PrimLinha as Integer

'Abre a caixa de diálogo para selecionar o arquivo
LocaldoArquivo = Application.GetOpenFilename()
'Ou indique um caminho com LocaldoArquivo = "C:\LOCAL_DO_ARQUIVO\banco-de-dados.txt"

NumArquivo = FreeFile() ' Atribui o primeiro número de arquivo disponível (E.g.: #1)

Open LocaldoArquivo For Input As #NumArquivo 'Abre o arquivo em modo de leitura

'Passar o Conteúdo para Planilha---
Dadosdetexto = Input(LOF(NumArquivo), NumArquivo) 'Carrega todo conteúdo do arquivo na variável
QuebraLinha = Split(Dadosdetexto, vbCrLf) 'Cria um vetor com cada linha do arquivo
UltLinha = UBound(QuebraLinha) 'Determina a última linha do vetor
PrimLinha = LBound(QuebraLinha) 'Determina a primeira linha do vetor
'Transpõem os vetores para a planilha
Range("A1").Resize((UltLinha) - (PrimLinha) + 1).Value = Application.Transpose(QuebraLinha)
'----------------------------------
Close #NumArquivo 'Fecha o arquivo (para o número em NumArquivo poder ser reutilizado)
End Sub



Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
Reinaldo
Jedi
Jedi
Mensagens: 1205
Registrado em: Sex Ago 01, 2014 4:09 pm
Localização: Garça - SP / SCS - SP

Re: Arquivos de Texto

Mensagem por Reinaldo » Qui Ago 22, 2019 8:53 pm

experimente:

Código: Selecionar todos

'Altera diretorio de trabalho
ChDir ("C:\temp") 'aqui fica o diretório

'Abre a caixa de diálogo para selecionar o arquivo
LocaldoArquivo = Application.GetOpenFilename()...


Reinaldo
Gostou da resposta?:?: :oops: :D :mrgreen:

fao17
Acabou de chegar
Acabou de chegar
Mensagens: 3
Registrado em: Seg Jun 10, 2019 7:10 pm

Re: Arquivos de Texto

Mensagem por fao17 » Qua Ago 28, 2019 7:38 pm

Muito obrigado pelo retorno Reinaldo.

Estou tentando realizar a mesma tarefa com este código abaixo.
Acompanhando com o F8 me parece que a leitura das linhas no arquivo txt esta sendo feita mas não esta copiando para a planilha.
Alguém consegue identificar onde estou errando?
Muito Obrigado.

Sub CapturaArquivo02()

Dim i As Long, j As Long

Range("A3").Select

Dim linSheet

'define o caminho do arquivo

Dim fDialog As Office.FileDialog

Dim varFile As Variant

Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.AllowMultiSelect = True
.Title = "Selecione o arquivo " & nomeAba
.Filters.Clear
.Filters.Add "All Files", "*.*"
.InitialFileName = " local do arquivo"

If .Show = True Then
For Each varFile In .SelectedItems
linSheet = GetLastRow(3, 10)

Open varFile For Input As #1

Do While Not EOF(1)
campos = Split(linha, ";")

'Distribui os campos na planilha
For j = 0 To UBound(campos)
Cells(i, j + 1).Value = campos(j)

Next
i = i + 1
DoEvents

Loop
Close #1
Next
Else
MsgBox "Nenhum arquivo foi selecionado"

End If

End With
MsgBox "FIM"
End Sub



Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder