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