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
Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
Importar TXT com delimitador.
-
- Manda bem
- Mensagens: 173
- Registrado em: Qua Mai 17, 2017 2:27 pm
-
- Manda bem
- Mensagens: 127
- Registrado em: Sex Out 05, 2018 2:42 pm
Re: Importar TXT com delimitador.
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.
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.
- Reinaldo
- Jedi
- Mensagens: 1537
- Registrado em: Sex Ago 01, 2014 4:09 pm
- Localização: Garça - SP / SCS - SP
Re: Importar TXT com delimitador.
Tov, como estão definidos Caminhox e Var1?
Onde é atribuido esses valores
Uma maneira de importar
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
-
- Manda bem
- Mensagens: 173
- Registrado em: Qua Mai 17, 2017 2:27 pm
Re: Importar TXT com delimitador.
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
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