Página 1 de 1

Importar txt de pen drive

Enviado: Qui Jun 28, 2012 7:14 pm
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

Re: Importar txt de pen drive

Enviado: Sex Jun 29, 2012 6:32 pm
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