Tomás Vásquez Fórum

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

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.

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

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