Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Importar TXT com delimitador.

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
Tov Elen Shau
Manda bem
Manda bem
Mensagens: 173
Registrado em: Qua Mai 17, 2017 2:27 pm

Importar TXT com delimitador.

Mensagem por Tov Elen Shau »

Pessoal

Boa tarde

Preciso de um help
Venho importando arquivos txt Delimitados por um | “paper” por uma rotina que busca em uma pasta um arquivo com um nome prefixado. Gostaria de alterar a rotina para que fosse possível chamar a pasta Localizar e se o arquivo fosse selecionado a rotina abaixo fosse executada. Alguém já tem essa rotina pronta ou consegue me ajudar com isso? O problema é que quando chega em .Name = Var1 da erro.
With Caminhox
.Name = Var1
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With


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.


Julio Mangilli
Manda bem
Manda bem
Mensagens: 127
Registrado em: Sex Out 05, 2018 2:42 pm

Re: Importar TXT com delimitador.

Mensagem por Julio Mangilli »

Olá amigo,

Eu tenho certeza que não consigo ajudar, uauhauhauhauahuahaua mas vou tentar e colocar algo aqui que as vezes desperta alguma ideia, você já é fera no assunto então.

E se uma função conseguisse verificar se o arquivo existe e dali mandasse rodar a macro ?

Function Arquivo_Existe(rng As Range) As Boolean
' **** funcao que verifica se arquivo existe sem informar a extensao Por Basole ****
Dim file As String, fileName As String
fileName = rng.Value & ".*"
file = Dir(fileName)

If file = "" Then
Arquivo_Existe = False

Else
Arquivo_Existe = True

End If
End Function

Ai se existir dentro da pasta manda buscar pelo próprio link.

Espero poder ajudar, abraço.


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

Re: Importar TXT com delimitador.

Mensagem por Reinaldo »

Tov, como estão definidos Caminhox e Var1?
Onde é atribuido esses valores
Uma maneira de importar

Código: Selecionar todos

Sub Macro1()
  Dim sPath As String
  Dim fName As String
  Dim s As String
  s = CurDir
  'mudar para onde deseja que o diálogo seja apontado
  'para quando ele é exibido
  sPath = "C:\Seu dirtorio\Seus arquivos"
  ChDrive sPath
  ChDir sPath
  fName = Application.GetOpenFilename( _
   Filefilter:="CSV Files (*.CSV),*.CSV")
  ChDrive s
  ChDir s
  If LCase(fName) = "false" Then Exit Sub
  With ActiveSheet.QueryTables.Add _
     (Connection:="TEXT;" & fName, _
      Destination:=Range("A1"))
      .Name = Replace(LCase(fName), ".xls", "")
      .TextFileSemicolonDelimiter = True
      .TextFileCommaDelimiter = False
      .TextFileSpaceDelimiter = False
      .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
      .TextFileTrailingMinusNumbers = True
      .Refresh BackgroundQuery:=False
  End With
End Sub


Tov Elen Shau
Manda bem
Manda bem
Mensagens: 173
Registrado em: Qua Mai 17, 2017 2:27 pm

Re: Importar TXT com delimitador.

Mensagem por Tov Elen Shau »

Boa tarde pessoal, desculpa a demora no feedback, somente hoje pude adaptar a rotina. Julio Mangilli, fiz exatamente o que você sugeriu. Primeiro uma rotina para saber se o arquivo havia sido localizado, se localizado executaria a rotina do Reinaldo. Reinaldo, obrigado pela rotina, inclui ela com os ajustes que eu queria e deu certo. Segue abaixo;

Sub Importar_Arquivo ()
Dim Caminho As String 'Caminho do arquivo
Dim fDialog As Office.FileDialog

'Configura caixa de seleção do arquivo
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.AllowMultiSelect = False 'Habilita ou desabilita a seleção de múltiplos arquivos
.Title = "Selecionar arquivo..."
'.InitialFileName = 'Caminho inicial para seleção, não utilizado no exemplo

'Configura filtros da caixa de seleção
.Filters.Clear 'Limpa os filtros
.Filters.Add "Arquivos Excel - .txt", "*.txt" 'Adiciona filtro para arquivos

If .Show = True Then 'Se o parâmetro .Show for igual à True significa que algum arquivo foi selecionado.

'=====FORMATA TODA A PLANILHA EM TEXTO
Cells.Select
Selection.NumberFormat = "@"
Range("B1").Select


Application.ScreenUpdating = False
'Aguardar um segundo antes da operação
LbProcesso.Caption = "AGUARDE, IMPORTANDO NOVO ARQUIVO..."
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 1
'Aguarda um segundo para executar a rotina
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime

Application.ScreenUpdating = False
'LIMPAR
Columns("B:BM").Select
Selection.Delete Shift:=xlToLeft
Range("B1").Select
ActiveWindow.SmallScroll Down:=-3
Range("A1").Select

Caminho = .SelectedItems.Item(1) 'Local + arquivo selecionados são passados para a variável chamada de "Caminho"
Application.ScreenUpdating = False

'LIMPAR A PLANILHA ANTES DA IMPORTAÇÃO
Columns("B:BM").Select
Selection.Delete Shift:=xlToLeft
Range("B1").Select
Range("A1").Select

Dim sPath As String
Dim fName As String
Dim s As String
s = CurDir
'mudar para onde deseja que o diálogo seja apontado
'para quando ele é exibido
sPath = Caminho
ChDrive sPath
Filefilter:="TXT Files (*.TXT),*.TXT")
fName = Caminho
ChDir s
If LCase(fName) = "false" Then Exit Sub

With ActiveSheet.QueryTables.Add _
(Connection:="TEXT;" & fName, _
Destination:=Range("A1"))
.Name = Replace(LCase(fName), ".txt", "")
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

Unload Me
Range("B1").Select
MsgBox "IMPORTADO COM SUCESSO!", vbInformation, "CONCLUIDO"

Else 'Caso .Show for igual a 'False' então não executar nada.

End If

End With

AbrirArquivo = Caminho 'Atribui o caminho do arquivo ao retorno da função

End Sub

Grato

Tov Elen Shau


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