Macro TABBULAÇÃO + ...
 
Notifications
Clear all

Macro TABBULAÇÃO + VBA FRM_Import arquivo txt

2 Posts
2 Usuários
0 Reactions
641 Visualizações
(@mmelinidt)
Posts: 0
New Member
Topic starter
 

Amigos, boa noite.

Sei que minha duvida deve ser bem simples, mas eu não estou conseguindo resolver, por isso, conto com a ajuda de voces.

Pois bem, criei uma macro, para tabular um determinado arquivo .txt A tabulação ficou perfeita, o único problema é a Macro, busca um único nome de arquivo e em uma única pasta. Sera que é possível mesclar esses dois códigos abaixo?
Segue abaixo

Função que cria um form e possibilita definir onde e qual arquivo txt quero importar.

Function AbrirArquivo()

    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 .txt
        .Filters.Add "Arquivos Excel - .xlsb", "*.xlsm" 'Adiciona filtro para arquivos .xlsn
        .Filters.Add "Arquivos Excel - .xls", "*.xls" 'Adiciona filtro para arquivos .xls
        
        If .Show = True Then    'Se o parâmetro .Show for igual à True significa
                                'que algum arquivo foi selecionado
            Caminho = .SelectedItems.Item(1)    'Local + arquivo selecionados são passados para
                                                'a variável chamada de "Caminho"
        Else
            MsgBox "Você clicou em cancelar"
        End If
        
    End With

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

End Function

Agora, segue a Macro GRAVADA
Nas linhas 3 até a linha 6, creio que esteja relacionada ao local fixo e ao arquivo fixo. será que conseguimos definir a função acima, no lugar desse caminho fixo??

Sub Macro1()
'
' Macro1 Macro
'
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;Z:CONT#Projeto3_TXT MARÇO4576763000136-546105209114-20130301-20130331.txt" _
        , Destination:=Range("$A$1"))
     '    .CommandType = 0
        .Name = _
        "04576763000136-546105209114-20130301"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = "|"
        .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub
 
Postado : 20/12/2017 6:35 pm
(@wagner-morel-vidal-nobre)
Posts: 4063
Famed Member
 

MMelinIdt,

Boa noite!

Seja muito bem vindo ao fórum.

Para aproveitar ao máximo o fórum e sempre manter o mesmo de forma organizada, sugiro ler os tópico da regras abaixo:
viewtopic.php?f=7&t=16757
viewtopic.php?f=7&t=203
viewtopic.php?f=7&t=7903
viewtopic.php?f=7&t=3841
viewtopic.php?f=7&t=12600
viewtopic.php?f=7&t=3371

Ao inserir código VBA no fórum, solicitamos, por gentileza, utilizar a ferramenta CODE existente no início da caixa de mensagens.

 
Postado : 20/12/2017 6:55 pm