Este fórum está sendo desativado

[JanilsonBrito]

Senhores, boa noite! mais uma vez preciso da ajuda de vocês. Consegui um código que importa todos arquivos *.TXT que tenho em um diretório, fiz algumas adaptações para minha utilização e funcionou, porem estou com um certo problema em um campo que tenho no arquivo. o campo data.
Consegui um código para converter o campo texto em data, porem quando tenho datas estão entre 01 e 09, na importação vem como "9092016" e se perde na conversão aparecendo na célula "###################"
Quando o campo esta entre 10 e 31, importa como 10092016 e o código funciona fazendo a conversão "10/09/2016"

O ARQUIVO VEM NO SEGUINTE FORMATO
performance;producao;aberturaonlinemvs1;hora;01092016;05:30
performance;producao;aberturaonlinemvs1;hora;02092016;05:59
performance;producao;aberturaonlinemvs1;hora;03092016;06:40
performance;producao;aberturaonlinemvs1;hora;05092016;04:49
performance;producao;aberturaonlinemvs1;hora;06092016;05:23
performance;producao;aberturaonlinemvs1;hora;07092016;04:31
performance;producao;aberturaonlinemvs1;hora;08092016;04:27
performance;producao;aberturaonlinemvs1;hora;09092016;04:20
performance;producao;aberturaonlinemvs1;hora;10092016;04:29
performance;producao;aberturaonlinemvs1;hora;12092016;04:05
performance;producao;aberturaonlinemvs1;hora;30082016;07:59

ESTOU UTILIZANDO O CÓDIGO DA SEGUINTE FORMA:
Sub importarArquivosTXT()
Dim myDir As String, fn As String, txt As String, a(), i As Long, ff As Integer
Dim Ficheiro As String
Dim rg As Range
Dim S As String, N As Long, C As Integer, X As Variant
myDir = "c:\temp\"
fn = Dir(myDir & "*.TXT")
Set rg = ActiveCell

Do While fn <> ""
ff = FreeFile
Open myDir & "\" & fn For Input As #ff
Do Until EOF(1)
Line Input #1, S
C = 0
X = Split(S, ";")
For N = 0 To UBound(X)
If X(N) <> "" Then
rg.Offset(0, C) = X(N)
C = C + 1
End If
Next N
Set rg = rg.Offset(1, 0)
Loop
Close #ff
fn = Dir()
Loop
With ThisWorkbook.Sheets(1).Range("a1")
For i = 1 To N
' .Offset(i - 1).Resize(, UBound(a(i)) + 1).Value = a(i)
Next
End With

End Sub


CÓDIGO QUE EU CONSEGUI PARA CONVERTER TEXTO EM DATA
Sub converterTextoData()
'
Dim i As Long
Application.ScreenUpdating = False
For i = 5 To 5
Columns(i).Select
Selection.TextToColumns Destination:=Cells(1, i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 4), TrailingMinusNumbers:=True
Next i
Application.ScreenUpdating = True
End Sub

[Reinaldo]

experimente/teste

Código: Selecionar todos

Sub importarArquivosTXT()
Dim myDir As String, fn As String, txt As String, a(), i As Long, ff As Integer
Dim Ficheiro As String
Dim rg As Range
Dim S As String, N As Long, C As Integer, X As Variant
myDir = "c:\temp\"
fn = Dir(myDir & "Test.TXT")
Set rg = ActiveCell

Do While fn <> ""
ff = FreeFile
Open myDir & "\" & fn For Input As #ff
Do Until EOF(1)
Line Input #1, S
C = 0
X = Split(S, ";")

For N = 0 To UBound(X)
    If X(N) <> "" Then
        If N = 4 Then
            rg.Offset(0, C) = CDate(VBA.Right(X(N), 4) & "/" & VBA.Mid(X(N), 3, 2) & "/" & VBA.Left(X(N), 2))
        Else
            rg.Offset(0, C) = X(N)
        End If
        C = C + 1
    End If
Next N
Set rg = rg.Offset(1, 0)
Loop
Close #ff
fn = Dir()
Loop
End Sub

[JanilsonBrito]

Reinaldo, ficou show de bola, era isso mesmo que eu precisava. Obrigado