Importar ficheros de texto

22/10/2003 - 23:39 por Hueeepa | Informe spam
Vi en un post de fecha 25/03/03 la manera de exportar un archivo de txt por
visual y es justo lo que necesito pues tengo una data que quisiera exportar
directamente a excel pero tiene más de 65000 registro de manera que debo
dividir en por lo menos dos archivos, he intentado con el wizard pero me
limita cuando coloco que comience despues de la línea 30000, averiguando en
el foro vi este código, pero me da un error en esta parte "strC1 Left(strCadena, InStr(strCadena, "") - 1)" a ver si alguien me puede
ayudar:

El codigo completo es:

Sub ImportarFicherosDeTexto()
Dim fsB As FileSearch
Dim wksH1 As Worksheet, wksH2 As Worksheet, wksH3 As Worksheet

Dim n As Integer
Dim strFich As String, intNumFich As Integer, lngRegistro As Long,
strCadLect As String * 1, strCadena As String, lngLOF As Double, lngPOS As
Double
Dim strC1 As String, strC2 As String

Set fsB = Application.FileSearch
Set wksH1 = Worksheets("Sheet1") 'Hoja donde se volcarán las primeras 24
filas del fichero de texto
Set wksH2 = Worksheets("Sheet2") ' " " " " " filas 25 a
48
Set wksH3 = Worksheets("Sheet3") ' " " " " " filas 49 a
72

With fsB
.NewSearch
.LookIn = "C:\Prueba" 'Directorio donde estén los ficheros de texto
.SearchSubFolders = False
.Filename = ".txt"
.Execute SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending
End With

For n = 1 To fsB.FoundFiles.Count

lngPOS = 1
lngRegistro = 1

intNúmFich = FreeFile()
strFich = fsB.FoundFiles(n)
Open strFich For Random Access Read As intNúmFich Len = 1
lngLOF = LOF(intNúmFich)

While lngPOS <= lngLOF
Get intNúmFich, lngPOS, strCadLect
If strCadLect <> vbCr And strCadLect <> vbLf Then
strCadena = strCadena & strCadLect
End If

If strCadLect = vbLf Or lngPOS = lngLOF Then
' Aqui es el error
strCadena = Trim(strCadena)
strC1 = Left(strCadena, InStr(strCadena, "") - 1)
strC2 = Right(strCadena, Len(strCadena) - InStr(strCadena,
"") - 1)

Select Case lngRegistro

Case 1 To 24
wksH1.Cells(wksH1.Range("A65536").End(xlUp).Row + 1,
1) = strC1
wksH1.Cells(wksH1.Range("B65536").End(xlUp).Row + 1,
2) = strC2
Case 25 To 48
wksH2.Cells(wksH2.Range("A65536").End(xlUp).Row + 1,
1) = strC1
wksH2.Cells(wksH2.Range("B65536").End(xlUp).Row + 1,
2) = strC2
Case 49 To 72
wksH3.Cells(wksH3.Range("A65536").End(xlUp).Row + 1,
1) = strC1
wksH3.Cells(wksH3.Range("B65536").End(xlUp).Row + 1,
2) = strC2
Case Else

End Select

lngRegistro = lngRegistro + 1
strCadena = ""

End If

lngPOS = lngPOS + 1

Wend

Close intNúmFich

Next n

Set wksH3 = Nothing
Set wksH2 = Nothing
Set wksH1 = Nothing
Set fsB = Nothing
End Sub

Muy agradecido, por su ayuda.
 

Leer las respuestas

#1 Alguien
23/10/2003 - 00:57 | Informe spam
Si lo q quieres es esportar directamente a excel xq no te creas una variable
del tipo Excel, en vez de pasar a fichero de texto para luego volver a leer.
Si estas en Visaul Basic debes ir primero al menu proyecto, referencias y
buscar ahi microsoft Excel, y activarlo una vez hecho eso ya puedes declarar
una variable
del tipo objeto de excel
Private Sub Form_Load()
Dim objExcel As Excel.Application, wrkLibro As Workbook
'
Set objExcel = New Excel.Application
Set wrkLibro = objExcel.Workbooks.Add
objExcel.Visible = True
'B2
ActiveCell.Offset(1, 1) = "Hola Mundo"

End Sub


"Hueeepa" escribió en el mensaje
news:
Vi en un post de fecha 25/03/03 la manera de exportar un archivo de txt


por
visual y es justo lo que necesito pues tengo una data que quisiera


exportar
directamente a excel pero tiene más de 65000 registro de manera que debo
dividir en por lo menos dos archivos, he intentado con el wizard pero me
limita cuando coloco que comience despues de la línea 30000, averiguando


en
el foro vi este código, pero me da un error en esta parte "strC1 > Left(strCadena, InStr(strCadena, "") - 1)" a ver si alguien me puede
ayudar:

El codigo completo es:

Sub ImportarFicherosDeTexto()
Dim fsB As FileSearch
Dim wksH1 As Worksheet, wksH2 As Worksheet, wksH3 As Worksheet

Dim n As Integer
Dim strFich As String, intNumFich As Integer, lngRegistro As Long,
strCadLect As String * 1, strCadena As String, lngLOF As Double, lngPOS As
Double
Dim strC1 As String, strC2 As String

Set fsB = Application.FileSearch
Set wksH1 = Worksheets("Sheet1") 'Hoja donde se volcarán las primeras


24
filas del fichero de texto
Set wksH2 = Worksheets("Sheet2") ' " " " " " filas 25


a
48
Set wksH3 = Worksheets("Sheet3") ' " " " " " filas 49


a
72

With fsB
.NewSearch
.LookIn = "C:\Prueba" 'Directorio donde estén los ficheros de


texto
.SearchSubFolders = False
.Filename = ".txt"
.Execute SortBy:=msoSortByFileName,


SortOrder:=msoSortOrderAscending
End With

For n = 1 To fsB.FoundFiles.Count

lngPOS = 1
lngRegistro = 1

intNúmFich = FreeFile()
strFich = fsB.FoundFiles(n)
Open strFich For Random Access Read As intNúmFich Len = 1
lngLOF = LOF(intNúmFich)

While lngPOS <= lngLOF
Get intNúmFich, lngPOS, strCadLect
If strCadLect <> vbCr And strCadLect <> vbLf Then
strCadena = strCadena & strCadLect
End If

If strCadLect = vbLf Or lngPOS = lngLOF Then
' Aqui es el error
strCadena = Trim(strCadena)
strC1 = Left(strCadena, InStr(strCadena, "") - 1)
strC2 = Right(strCadena, Len(strCadena) - InStr(strCadena,
"") - 1)

Select Case lngRegistro

Case 1 To 24
wksH1.Cells(wksH1.Range("A65536").End(xlUp).Row +


1,
1) = strC1
wksH1.Cells(wksH1.Range("B65536").End(xlUp).Row +


1,
2) = strC2
Case 25 To 48
wksH2.Cells(wksH2.Range("A65536").End(xlUp).Row +


1,
1) = strC1
wksH2.Cells(wksH2.Range("B65536").End(xlUp).Row +


1,
2) = strC2
Case 49 To 72
wksH3.Cells(wksH3.Range("A65536").End(xlUp).Row +


1,
1) = strC1
wksH3.Cells(wksH3.Range("B65536").End(xlUp).Row +


1,
2) = strC2
Case Else

End Select

lngRegistro = lngRegistro + 1
strCadena = ""

End If

lngPOS = lngPOS + 1

Wend

Close intNúmFich

Next n

Set wksH3 = Nothing
Set wksH2 = Nothing
Set wksH1 = Nothing
Set fsB = Nothing
End Sub

Muy agradecido, por su ayuda.


Preguntas similares