[Resolvido] Ler txt e gravar no excel, delimitado por espaço

[Alexandre Luccia 1]

Ler arquivo txt e colocar no excel...

 

Estou usando a seguinte estrutura

 

Private Sub Command1_Click()

Dim xlapp As Excel.Application

Dim xlbook As Excel.Workbook

Dim xlsheet As Excel.Worksheet

Dim i As Long

Dim linha As String

' abrindo excel

Set xlapp = CreateObject("excel.application")

Set xlbook = xlapp.Workbooks.Add

'1 planilha 1(plan1)

Set xlsheet = xlbook.Worksheets(1)

xlapp.Visible = True

'abrindo arquivo texto

 

Open txttexto.Text For Input As #1

i = 2

topo = 1

 

'xlsheet.Range("a" & CStr(i)).Value = Mid(linha, 1, 5)

 

xlsheet.Range("a" & CStr(topo)).Value = "Current Data"

xlsheet.Range("b" & CStr(topo)).Value = "Current Time"

xlsheet.Range("c" & CStr(topo)).Value = "Number of licensed users specified by the configuration file"

xlsheet.Range("d" & CStr(topo)).Value = "Current number of total connections"

xlsheet.Range("e" & CStr(topo)).Value = "Maximum number of total connections"

xlsheet.Range("f" & CStr(topo)).Value = "Minimum number of total connections"

xlsheet.Range("g" & CStr(topo)).Value = "Current number of interactive connections"

xlsheet.Range("h" & CStr(topo)).Value = "Maximum number of interactive connections for the last hour"

xlsheet.Range("i" & CStr(topo)).Value = "Minimum number of interactive connections for the past hour"

xlsheet.Range("j" & CStr(topo)).Value = "Current number of batch connections"

xlsheet.Range("k" & CStr(topo)).Value = "Maximum number of batch connections for the past hour"

xlsheet.Range("l" & CStr(topo)).Value = "Minimum number of batch connections for the past hour"

 

Do While Not EOF(1)

Line Input #1, linha

xlsheet.Range("a" & CStr(i)).Value = Mid(linha, 1, 8)

xlsheet.Range("b" & CStr(i)).Value = Mid(linha, 11, 8)

xlsheet.Range("c" & CStr(i)).Value = Mid(linha, 21, 1)

xlsheet.Range("d" & CStr(i)).Value = Mid(linha, 23, 1)

xlsheet.Range("e" & CStr(i)).Value = Mid(linha, 25, 1)

xlsheet.Range("f" & CStr(i)).Value = Mid(linha, 27, 1)

xlsheet.Range("g" & CStr(i)).Value = Mid(linha, 29, 1)

xlsheet.Range("h" & CStr(i)).Value = Mid(linha, 31, 1)

xlsheet.Range("i" & CStr(i)).Value = Mid(linha, 33, 1)

xlsheet.Range("j" & CStr(i)).Value = Mid(linha, 35, 1)

xlsheet.Range("k" & CStr(i)).Value = Mid(linha, 37, 1)

xlsheet.Range("l" & CStr(i)).Value = Mid(linha, 39, 1)

i = i + 1

Loop

End Sub

 

 

Porém dessa forma ele pegas os campos com o mid, o problema é que tem valores que nao são fixos e estão separados por espaço, inclusive no começo ele separa por dois...

 

O arquivo esta vindo assim

04/05/11 01:00:00 5 3 4 0 3 4 0 0 0 004/05/11 02:00:00 5 3 36 3 3 3 3 0 0 004/05/11 03:00:00 5 3 3 83 3 3 3 80 0 004/05/11 04:00:00 5 3 3 33 3 3 3 0 0 004/05/11 05:00:00 5 3 3 3 63 3 3 0 0 004/05/11 06:00:00 5 3 3 83 3 3 3 0 0 004/05/11 07:00:00 5 3 3 3 3 3 3 0 0 0

 

O que fazer :(

[KhaosDoctor 242]

Como eles deveriam aparecer?

[Alexandre Luccia 1]

Como eles deveriam aparecer?

 

 

Obrigado pela resposta, devem aparecer assim divididos em colunas A | B | C...

 

04/05/11|01:00:00|5|3|4|0|3|4|0|06|0|0

04/05/11|01:00:00|5|23|4|0|3|4|0|0|0|0

04/05/11|01:00:00|56|3|4|0|3|4|0|0|06|60

04/05/11|01:00:00|5|3|4|0|83|4|80|0|80|0

 

Agradeço ajuda :)

[KhaosDoctor 242]

Beleza, só me esclareça uma coisa, esse sistema é o que? Windows forms? Web?

[Alexandre Luccia 1]

VB6 windows forms, agradeço ajuda

[Alexandre Luccia 1]

Consegui, para quem precisar, segue:

 

 

Private Sub Command1_Click()

ListView1.ListItems.Clear

Dim linha As String

Dim texto As String

Dim llinha As String

 

ListView1.ColumnHeaders.Add , , "Z", 1

ListView1.ColumnHeaders.Add , , "A", 940

ListView1.ColumnHeaders.Add , , "B", 940

ListView1.ColumnHeaders.Add , , "C", 555

ListView1.ColumnHeaders.Add , , "D", 555

ListView1.ColumnHeaders.Add , , "E", 555

ListView1.ColumnHeaders.Add , , "F", 555

ListView1.ColumnHeaders.Add , , "G", 555

ListView1.ColumnHeaders.Add , , "H", 555

ListView1.ColumnHeaders.Add , , "I", 555

ListView1.ColumnHeaders.Add , , "J", 555

ListView1.ColumnHeaders.Add , , "K", 555

ListView1.ColumnHeaders.Add , , "L", 555

 

'mostra a coluna

ListView1.View = lvwReport

 

'inseri itens

Dim itmx As ListItem

 

Dim contador12 As Integer

contador12 = 0

 

Name Text1.Text As "c:\crk.txt"

Open "c:\crk.txt" For Input As #1

 

Do Until EOF(1)

Line Input #1, linha

 

texto = linha

vetor = Split(texto, " ")

 

For i = LBound(vetor) To UBound(vetor)

llinha = vetor(i)

 

'Zera contador no fim de colunas listview

If contador12 = 14 Then

contador12 = 1

End If

 

'Contador para quebra de linha

If contador12 = 13 Then

'insere ultimo valor que está grudado junto a data

contador12 = contador12 + 1

Else

contador12 = contador12 + 1

End If

 

'Tratamento pegar data sem ultimo dado de registro

'contalinha = LTrim(Len(lLinha))

If LTrim(Len(llinha)) = 10 Then

llinha2 = Mid(llinha, 1, 1)

llinha = Mid(llinha, 2, 10)

itmx.SubItems(12) = llinha2

End If

 

 

If Len(LTrim(llinha)) = 9 Then

Set itmx = ListView1.ListItems.Add(, , i)

itmx.SubItems(1) = llinha

End If

 

If contador12 <> 13 Then

'Verifica e coloca hora em primeira linha

If Len(llinha) = 8 And Mid(llinha, 3, 1) = "/" Then

'Insere primeira coluna do listview

Set itmx = ListView1.ListItems.Add(, , i)

itmx.SubItems(1) = llinha

ElseIf Len(llinha) = 8 And Mid(llinha, 3, 1) = ":" Then

itmx.SubItems(2) = llinha

End If

End If

 

'Tratar valor em branco e pegar valor de um numero

If contador12 = 5 Then

 

If Len(llinha) = 1 Or Len(llinha) = 2 Then

itmx.SubItems(3) = llinha

End If

 

ElseIf contador12 = 6 Then

 

If Len(llinha) = 1 Or Len(llinha) = 2 Then

itmx.SubItems(4) = llinha

End If

 

ElseIf contador12 = 7 Then

 

If Len(llinha) = 1 Or Len(llinha) = 2 Then

itmx.SubItems(5) = llinha

End If

 

ElseIf contador12 = 8 Then

 

If Len(llinha) = 1 Or Len(llinha) = 2 Then

itmx.SubItems(6) = llinha

End If

 

ElseIf contador12 = 9 Then

 

If Len(llinha) = 1 Or Len(llinha) = 2 Then

itmx.SubItems(7) = llinha

End If

 

ElseIf contador12 = 10 Then

 

If Len(llinha) = 1 Or Len(llinha) = 2 Then

itmx.SubItems(8) = llinha

End If

 

ElseIf contador12 = 11 Then

 

If Len(llinha) = 1 Or Len(llinha) = 2 Then

itmx.SubItems(9) = llinha

End If

 

ElseIf contador12 = 12 Then

 

If Len(llinha) = 1 Or Len(llinha) = 2 Then

itmx.SubItems(10) = llinha

End If

 

ElseIf contador12 = 13 Then

 

If Len(llinha) = 1 Or Len(llinha) = 2 Then

itmx.SubItems(11) = llinha

End If

 

ElseIf contador12 = 14 Then

 

If Len(llinha) = 1 Or Len(llinha) = 2 Then

itmx.SubItems(12) = llinha2

End If

 

End If

 

Next

 

Loop

 

Close #1

 

Name "c:\crk.txt" As Text1.Text

 

End Sub

 

Private Sub Command2_Click()

Dim xlApp As Object

Dim xlWb As Object

Dim xlWs As Object

 

Set xlApp = CreateObject("Excel.Application")

Set xlWb = xlApp.Workbooks.Add

Set xlWs = xlWb.Worksheets(1)

 

xlApp.Visible = True

xlApp.UserControl = True

 

xlWs.Cells(1, 1).Value = "current date"

xlWs.Cells(1, 2).Value = "current time"

xlWs.Cells(1, 3).Value = "Number of licensed users specified by the configuration file"

xlWs.Cells(1, 4).Value = "Current number of total connections"

xlWs.Cells(1, 5).Value = "Maximum number of total connections"

xlWs.Cells(1, 6).Value = "Minimum number of total connections"

xlWs.Cells(1, 7).Value = "Current number of interactive connections"

xlWs.Cells(1, 8).Value = "Maximum number of interactive connections for the last hour"

xlWs.Cells(1, 9).Value = "Minimum number of interactive connections for the past hour"

xlWs.Cells(1, 10).Value = "Current number of batch connections"

xlWs.Cells(1, 11).Value = "Maximum number of batch connections for the past hour"

xlWs.Cells(1, 12).Value = "Minimum number of batch connections for the past hour"

 

For i = 2 To ListView1.ListItems.Count

 

xlWs.Cells(i, 1).Value = ListView1.ListItems(i).SubItems(1)

xlWs.Cells(i, 2).Value = ListView1.ListItems(i).SubItems(2)

xlWs.Cells(i, 3).Value = ListView1.ListItems(i).SubItems(3)

xlWs.Cells(i, 4).Value = ListView1.ListItems(i).SubItems(4)

xlWs.Cells(i, 5).Value = ListView1.ListItems(i).SubItems(5)

xlWs.Cells(i, 6).Value = ListView1.ListItems(i).SubItems(6)

xlWs.Cells(i, 7).Value = ListView1.ListItems(i).SubItems(7)

xlWs.Cells(i, 8).Value = ListView1.ListItems(i).SubItems(8)

xlWs.Cells(i, 9).Value = ListView1.ListItems(i).SubItems(9)

xlWs.Cells(i, 10).Value = ListView1.ListItems(i).SubItems(10)

xlWs.Cells(i, 11).Value = ListView1.ListItems(i).SubItems(11)

xlWs.Cells(i, 12).Value = ListView1.ListItems(i).SubItems(12)

Next

 

End Sub