Notifications
Clear all

Abrir uma caixa para buscar arquivo

9 Posts
3 Usuários
0 Reactions
1,474 Visualizações
(@digo203)
Posts: 117
Estimable Member
Topic starter
 

Boa Tarde Senhores!

Gostaria da ajuda de vcs para incluir um codigo.

Em anexo segue a planilha e a explicaçao do que eu preciso.

Abraços,

 
Postado : 03/02/2014 11:19 am
(@digo203)
Posts: 117
Estimable Member
Topic starter
 

Boa Tarde Senhores!

Gostaria da ajuda de vcs para incluir um codigo.

Em anexo segue a planilha e a explicaçao do que eu preciso.

Abraços,

Olá pessoal!

Pesquisando eu achei o codigo abaixo que ja fez metade do que eu preciso.

strArquivo = Application.GetOpenFilename("Arquivos de texto (*.txt),*.txt")
Workbooks.OpenText Filename:= _
strArquivo, _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True

O problema é que o arquivo terá o nome + ou - assim: VBRP.dd.mm.aaa, sendo que a data mudara conforme o dia.

Alguem tem uma soluçao?

 
Postado : 03/02/2014 3:52 pm
(@gtsalikis)
Posts: 2373
Noble Member
 

Digo, afinal, vc quer uma opção para selecionar o arquivo, ou vc quer configurar o código para selecionar o arquivo automaticamente, de acordo com a data?

 
Postado : 03/02/2014 3:59 pm
(@digo203)
Posts: 117
Estimable Member
Topic starter
 

Digo, afinal, vc quer uma opção para selecionar o arquivo, ou vc quer configurar o código para selecionar o arquivo automaticamente, de acordo com a data?

Olá gtsalikis!

Como fiz a macro no metodo de gravaçao, ela sempre pega o mesmo arquivo.

O que eu necessito é que abra uma caixa de dialogo/pesquisa para selecionar o arquivo txt que tera o nome (VBRP.dd.mm.aaaa), que mudará constantemente conforme o dia.

 
Postado : 03/02/2014 5:52 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Não entendi, o código que "achou" já faz isso (o descrito)
adaptado ao seu seria +/- assim

strArquivo = Application.GetOpenFilename("Arquivos de texto (*.txt),*.txt") '
    Workbooks.OpenText Filename:=strArquivo, Origin:=xlMSDOS, _
        StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(6, _
        1), Array(18, 1), Array(25, 1), Array(60, 1), Array(80, 1), Array(99, 1), Array(112, 1)), _
        TrailingMinusNumbers:=True
    Range("$B$15:$H$300").Select
......

Selecione o arquivo e veja oque ocorre.

 
Postado : 04/02/2014 6:03 am
(@digo203)
Posts: 117
Estimable Member
Topic starter
 

Não entendi, o código que "achou" já faz isso (o descrito)
adaptado ao seu seria +/- assim

strArquivo = Application.GetOpenFilename("Arquivos de texto (*.txt),*.txt") '
    Workbooks.OpenText Filename:=strArquivo, Origin:=xlMSDOS, _
        StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(6, _
        1), Array(18, 1), Array(25, 1), Array(60, 1), Array(80, 1), Array(99, 1), Array(112, 1)), _
        TrailingMinusNumbers:=True
    Range("$B$15:$H$300").Select
......

Selecione o arquivo e veja oque ocorre.

Olá Reinaldo, bom dia!

Obrigado pela resposta.

Ao selecionar o arquivo rodou até certa parte.
Por favor, pode me tirar uma duvida?

Como fiz a macro no metodo de gravação, quando ela pega o txt e joga pro excel, ela gera uma sheets com o nome do txt usado na gravação, por exemplo nas linhas em negrito:

Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Range("$B$2").Select
ActiveSheet.Paste
Selection.SpecialCells(xlCellTypeBlanks).Select
Application.CutCopyMode = False
Selection.EntireRow.Delete
Sheets("teste2").Select

Range("$G$1").Select
Selection.Copy
Sheets("Plan1").Select
Range("$I$2").Select
ActiveSheet.Paste
Cells.Replace What:="aj", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Selection.Value = Format(Selection, "dd/mm/yy")
Range("$B$2:$I$200").Select
Application.CutCopyMode = False
Selection.Copy

Windows("VBR.xlsm").Activate
Range("$C$52").Select
Selection.Insert Shift:=xlDown

Range("$C$52:$I$250").Select

Selection.SpecialCells(xlCellTypeBlanks).Select
Application.CutCopyMode = False
Selection.EntireRow.Delete
Range("K50").Select

Windows("teste2.txt").Activate
Sheets("Plan1").Select
ActiveWindow.Close False
Range("I6").Select

Tem com alterar essa parte para que a macro rode com qualquer txt selecionado?

 
Postado : 04/02/2014 6:35 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Experimente assim:

strArquivo = Application.GetOpenFilename("Arquivos de texto (*.txt),*.txt") '
    Workbooks.OpenText Filename:=strArquivo, Origin:=xlMSDOS, _
        StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(6, _
        1), Array(18, 1), Array(25, 1), Array(60, 1), Array(80, 1), Array(99, 1), Array(112, 1)), _
        TrailingMinusNumbers:=True
    nWo = ActiveWorkbook.Name 'Nome do arquivo aberto
    nSh = ActiveSheet.Name 'Nome da planilha no arquivo aberto
    Range("$B$15:$H$300").Select
......

Onde houver referencia a planilha ou Arquivo altere
de : Sheets("teste2").Select para: Sheets(nSh).Select
de : Windows("teste2.txt").Activate para : Windows(nWo).Activate

 
Postado : 04/02/2014 6:55 am
(@digo203)
Posts: 117
Estimable Member
Topic starter
 

Experimente assim:

strArquivo = Application.GetOpenFilename("Arquivos de texto (*.txt),*.txt") '
    Workbooks.OpenText Filename:=strArquivo, Origin:=xlMSDOS, _
        StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(6, _
        1), Array(18, 1), Array(25, 1), Array(60, 1), Array(80, 1), Array(99, 1), Array(112, 1)), _
        TrailingMinusNumbers:=True
    nWo = ActiveWorkbook.Name 'Nome do arquivo aberto
    nSh = ActiveSheet.Name 'Nome da planilha no arquivo aberto
    Range("$B$15:$H$300").Select
......

Onde houver referencia a planilha ou Arquivo altere
de : Sheets("teste2").Select para: Sheets(nSh).Select
de : Windows("teste2.txt").Activate para : Windows(nWo).Activate

Reinaldo,

1º - Muitissimo obrigado por sua ajuda
2º - Parabens pelo seu conhecimento e por se dispor a ajudar aos que nao sabem. Rodou perfeitamente.

Agradeço tb a todos que me ajudaram.

Fiquem na PAZ.

Abraços,

 
Postado : 04/02/2014 7:05 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Caso seja necessário reabrir o tópico, o autor poderá enviar uma MP para um dos moderadores solicitando o desbloqueio.

 
Postado : 04/02/2014 6:07 pm