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

Importar txt de pen drive

Ponto de encontro entre aqueles que precisam e fornecem soluções baseadas no Microsoft Excel e VBA. Precisa de uma solucão em VBA? É um consultor ou programador independente? Esse é o lugar!
alemocmg
Acabou de chegar
Acabou de chegar
Mensagens: 3
Registrado em: Qui Jun 28, 2012 7:03 pm

Importar txt de pen drive

Mensagem por alemocmg »

O problema e o seguinte tenho uma planilha que importa dados de
um pen drive, so que as vezes este drive muda E: para varios outros
gostaria de um comando que eu pudesse informa somente qual drive busca
e o resto proceguisse normal

veja o ex:

Sub Macro4()
'
' Macro4 Macro
'

'
On Error GoTo TrataErro

Open "E:\LINHA_A\DETALHEDASCELULAS.txt" For Input As #1

Close #1

Range("O1:AA85").Select
Selection.Copy

Range("A1").Select
ActiveSheet.Paste
Range("O1").Select
Application.CutCopyMode = False

Range("O1:AA85").Select
Selection.ClearContents
Range("O2").Select

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;E:\LINHA_A\DETALHEDASCELULAS.txt", Destination:=Range("$O$2"))
.Name = "DETALHEDASCELULAS_5"
.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 = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileOtherDelimiter = "'"
.TextFileColumnDataTypes = Array(9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 1, 1, 9, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

Columns("Q:Q").EntireColumn.AutoFit

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;E:\LINHA_A\DADOSDASCELULAS.txt", Destination:=Range("$BP$1"))
.Name = "DADOSDASCELULAS"
.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 = xlTextQualifierSingleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileOtherDelimiter = ")"
.TextFileColumnDataTypes = Array(9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 1, 1, 1, 9, 9, 9, 9, _
1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

Range("BP1:BU1").Select
Selection.Cut

Range("O1").Select
ActiveSheet.Paste
Range("O2").Select
Range("Q1").Select
Selection.Copy
Range("BD17:BE17").Select
ActiveSheet.Paste
Application.CutCopyMode = False

TrataErro:
MsgBox Err.Description, vbExclamation + vbOKOnly, "Erro: " & CStr(Err.Number)
#If DESENV Then ' Compilação condicional - Em desenvolvimento
Stop
Exit Sub
#End If

Range("O2").Select

Application.CutCopyMode = True
If Err.Number = 0 Then

MsgBox "Importado"
End If

End Sub


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.


Avatar do usuário
webmaster
Administrador
Mensagens: 3114
Registrado em: Sex Jul 24, 2009 2:44 pm
Contato:

Re: Importar txt de pen drive

Mensagem por webmaster »

Opa!

Isso ajuda?

Código: Selecionar todos

Sub DriveTypeAndList()
    Dim objDrv      As Object
    Dim strMsg      As String
 
    For Each objDrv In CreateObject("Scripting.FileSystemObject").Drives
        Select Case objDrv.DriveType
            Case 0: strMsg = strMsg & vbNewLine & objDrv.DriveLetter & ": Unknown"
            Case 1: strMsg = strMsg & vbNewLine & objDrv.DriveLetter & ": Removable Drive"
            Case 2: strMsg = strMsg & vbNewLine & objDrv.DriveLetter & ": Hard Disk Drive"
            Case 3: strMsg = strMsg & vbNewLine & objDrv.DriveLetter & ": Network Drive"
            Case 4: strMsg = strMsg & vbNewLine & objDrv.DriveLetter & ": CDROM Drive"
            Case 5: strMsg = strMsg & vbNewLine & objDrv.DriveLetter & ": RAM Disk Drive"
        End Select
    Next
 
    Set objDrv = Nothing
    MsgBox strMsg, vbInformation, "Excel Experts Tip"
End Sub
Referência:

http://excelexperts.com/List-and-Type-of-Drives-VBA

Abraços


Responder