Trabajar con cadenas en visual basic

Tío, saludos, a ver si me puedes ayudar...
Veras, los que deseo es simple pero es que no lo consigo. Estoy utilizando Visual Basic y me gustaría poder leer caracteres de un fichero txt e ir identificando cada uno de ellos para descartarlos o almacenarlos en una base de datos.
Es como decodificar un fichero txt de datos e ir guardando en la base de datos (utilizando un data) los que me interesen.
A ver si es posible que me indiques el código necesario para realizar la lectura de los caracteres del fichero y el acceso a ellos. Gracias.
Un saludo

1 Respuesta

Respuesta
1
Tienes que utilizar una referencia en tu proyecto a filesystemobject, con esto puedes trabajar la lectura de cualquier archivo.
Usa la siguiente rutina y adáptala:
Private Sub cmdLeer_Click()
Dim DLG_FILE_OPEN
Dim cdlOFNFileMustExist
Dim osf As Object
Dim Archivo As TextStream
Dim sLinea As String
Dim dLargo As Double
Dim dContador As Double
Dim cierto As Boolean
Dim iContador As Integer
Dim dFecha As String
Dim iVez As Integer
Dim iVezSuma As Integer
Dim sPaso As String
Dim sInstancia As String
Dim sMesTexto As String
Dim sDia As String
Dim sEjercicio As String
Dim sVG As String
Dim sVG1 As String
Dim sTamano As String
Dim sOcupado As String
Dim sLibre As String
Dim sBase As String
Dim lLineas As Long
Me.sprSinIntegrar.MaxRows = 0
Me.sprDatos.MaxRows = 0
cdlOFNFileMustExist = &H1000
DLG_FILE_OPEN = 1
With mdiPrincipal.CommonDialog1
.DialogTitle = "Especifique el nombre del archivo de Texto a Leer..."
.Filter = "Text Files (*.txt)|*.txt"
.FilterIndex = 2
.MaxFileSize = 30000
.Flags = cdlOFNFileMustExist
'Banderas
.CancelError = False
.DefaultExt = ".txt"
' display the Open File Dialog
'Acción de Salvar el Archivo
.Action = DLG_FILE_OPEN
End With
If mdiPrincipal.CommonDialog1.FileName = vbNullString Then
Exit Sub
End If
Set osf = CreateObject("scripting.filesystemobject")
Set Archivo = osf.OpenTextFile(mdiPrincipal.CommonDialog1.FileName, ForReading)
' Se lee todo el archivo
cierto = True
iContador = 1
iVezSuma = 0
lLineas = 0
Screen.MousePointer = vbHourglass
While Not Archivo.AtEndOfStream
sLinea = Archivo.ReadLine
lLineas = lLineas + 1
'debug.Print sLinea
If InStr(1, sLinea, Chr(34)) <> 0 And InStr(1, sLinea, "return") = 0 And InStr(1, sLinea, "NULL") = 0 Then
If InStr(1, sLinea, "NULL") = 0 Then
' nombre de la instancia
iVez = 0
sBase = "vg_det"
For dLargo = 1 To Len(sLinea)
If Mid$(sLinea, dLargo, 1) = Chr(34) Then
iVez = iVez + 1
End If
If iVez = 2 Then
Exit For
End If
Next
dLargo = dLargo + 1
sPaso = ""
sVG = ""
For dContador = dLargo To Len(sLinea)
If Mid$(sLinea, dContador, 1) <> Chr(34) Then
If Mid$(sLinea, dContador, 1) <> vbTab Then
sPaso = sPaso & Mid$(sLinea, dContador, 1)
End If
Else
Exit For
End If
Next
' nombre de la instancia
sInstancia = LTrim$(RTrim$(sPaso))
' se toma la fecha
dLargo = dContador + 1
sMesTexto = Cambia_Mes(Mid$(sLinea, dLargo, 3))
dLargo = dLargo + 4
sDia = Mid$(sLinea, dLargo, 2)
dLargo = dLargo + 4
sEjercicio = Mid$(sLinea, dLargo, 4)
End If
End If
If InStr(1, sLinea, "FS") <> 0 Or InStr(1, sLinea, "vg") <> 0 Then
' vamos por los datos de espacios
If InStr(1, sLinea, "FS") <> 0 Then
sVG = Mid$(sLinea, 1, 2)
iVez = 0
sVG1 = ""
sTamano = ""
sOcupado = ""
sLibre = ""
For dContador = 6 To Len(sLinea)
If Mid$(sLinea, dContador, 1) <> vbTab Then
If iVez = 0 Then
sVG1 = sVG1 & Mid$(sLinea, dContador, 1)
End If
Else
iVez = iVez + 1
dContador = dContador + 1
End If
Select Case iVez
Case 1
sTamano = sTamano & Mid$(sLinea, dContador, 1)
Case 2
sOcupado = sOcupado & Mid$(sLinea, dContador, 1)
Case 3
sLibre = sLibre & Mid$(sLinea, dContador, 1)
End Select
Next
If iVez >= 3 Then
' ya tenemos todos los datos del registro
Me.sprDatos.MaxRows = Me.sprDatos.MaxRows + 1
Me.sprDatos.Row = Me.sprDatos.MaxRows
Me.sprDatos.Col = 1
Me.sprDatos.Text = sInstancia
Me.sprDatos.Col = 2
Me.sprDatos.Value = sDia & "/" & sMesTexto & "/" & sEjercicio
Me.sprDatos.Col = 3
Me.sprDatos.Value = sVG
Me.sprDatos.Col = 4
Me.sprDatos.Value = sVG1
Me.sprDatos.Col = 5
Me.sprDatos.Value = sTamano
Me.sprDatos.Col = 6
Me.sprDatos.Value = sOcupado
Me.sprDatos.Col = 7
Me.sprDatos.Value = sLibre
Me.sprDatos.Col = 8
Me.sprDatos.Value = sBase
sVG = vbNullString
sVG1 = vbNullString
sTamano = vbNullString
sOcupado = vbNullString
sLibre = vbNullString
iVez = 0
Me.Label1.Caption = "Registros Procesados: " & Format$(Me.sprDatos.MaxRows, "###,###,###")
DoEvents
End If
Else
For dContador = 1 To Len(sLinea)
If Mid$(sLinea, dContador, 1) <> vbTab Then
sVG = sVG & Mid$(sLinea, dContador, 1)
Else
Exit For
End If
Next
iVez = 0
sVG1 = " "
sTamano = ""
sOcupado = ""
sLibre = ""
dContador = dContador + 1
For dLargo = dContador To Len(sLinea)
If Mid$(sLinea, dLargo, 1) <> vbTab Then
If iVez = 0 Then
sTamano = sTamano & Mid$(sLinea, dLargo, 1)
End If
Else
iVez = iVez + 1
dLargo = dLargo + 1
End If
Select Case iVez
Case 1
sOcupado = sOcupado & Mid$(sLinea, dLargo, 1)
Case 2
sLibre = sLibre & Mid$(sLinea, dLargo, 1)
End Select
Next
If iVez >= 2 Then
' ya tenemos todos los datos del registro
Me.sprDatos.MaxRows = Me.sprDatos.MaxRows + 1
Me.sprDatos.Row = Me.sprDatos.MaxRows
Me.sprDatos.Col = 1
Me.sprDatos.Text = sInstancia
Me.sprDatos.Col = 2
Me.sprDatos.Value = sDia & "/" & sMesTexto & "/" & sEjercicio
Me.sprDatos.Col = 3
Me.sprDatos.Value = sVG
Me.sprDatos.Col = 4
Me.sprDatos.Value = sVG1
Me.sprDatos.Col = 5
Me.sprDatos.Value = sTamano
Me.sprDatos.Col = 6
Me.sprDatos.Value = sOcupado
Me.sprDatos.Col = 7
Me.sprDatos.Value = sLibre
Me.sprDatos.Col = 8
Me.sprDatos.Value = sBase
sVG = vbNullString
sVG1 = vbNullString
sTamano = vbNullString
sOcupado = vbNullString
sLibre = vbNullString
iVez = 0
Me.Label1.Caption = "Registros Procesados: " & Format$(Me.sprDatos.MaxRows, "###,###,###")
DoEvents
End If
End If
End If
If InStr(1, sLinea, "sum") <> 0 Or InStr(1, sLinea, "Total") <> 0 Then
' el renglón de los totales
sVG = "SUM"
If sBase <> "bd_det" Then
sBase = "vg_tot"
Else
sBase = "bd_tot"
End If
iVezSuma = iVezSuma + 1
Else
If sVG = "SUM" And InStr(1, sLinea, "NULL") = 0 Then
iVezSuma = iVezSuma + 1
Else
If iVezSuma > 0 And InStr(1, sLinea, "NULL") = 0 Then
iVezSuma = iVezSuma - 1
Else
If iVezSuma > 0 And InStr(1, sLinea, "NULL") <> 0 Then
iVezSuma = iVezSuma - 1
sVG = ""
End If
End If
End If
End If
If iVezSuma >= 2 Then
' se toman los totales
iVezSuma = 0
iVez = 0
sVG1 = " "
sTamano = ""
sOcupado = ""
sLibre = ""
For dLargo = 1 To Len(sLinea)
If Mid$(sLinea, dLargo, 1) <> vbTab Then
If iVez = 1 Then
sTamano = sTamano & Mid$(sLinea, dLargo, 1)
End If
Else
iVez = iVez + 1
If iVez > 1 Then
dLargo = dLargo + 1
End If
End If
Select Case iVez
Case 2
sOcupado = sOcupado & Mid$(sLinea, dLargo, 1)
Case 3
sLibre = sLibre & Mid$(sLinea, dLargo, 1)
End Select
Next
If iVez >= 2 Then
' ya tenemos todos los datos del registro
Me.sprDatos.MaxRows = Me.sprDatos.MaxRows + 1
Me.sprDatos.Row = Me.sprDatos.MaxRows
Me.sprDatos.Col = 1
Me.sprDatos.Text = sInstancia
Me.sprDatos.Col = 2
Me.sprDatos.Value = sDia & "/" & sMesTexto & "/" & sEjercicio
Me.sprDatos.Col = 3
Me.sprDatos.Value = sVG
Me.sprDatos.Col = 4
Me.sprDatos.Value = sVG1
Me.sprDatos.Col = 5
Me.sprDatos.Value = sTamano
Me.sprDatos.Col = 6
Me.sprDatos.Value = sOcupado
Me.sprDatos.Col = 7
Me.sprDatos.Value = sLibre
Me.sprDatos.Col = 8
Me.sprDatos.Value = sBase
sBase = "bd_det"
sVG = vbNullString
sVG1 = vbNullString
sTamano = vbNullString
sOcupado = vbNullString
sLibre = vbNullString
iVez = 0
iVezSuma = 0
Me.Label1.Caption = "Registros Procesados: " & Format$(Me.sprDatos.MaxRows, "###,###,###")
DoEvents
End If
End If
If InStr(1, sLinea, "Nombre Base") <> 0 Or sVG = "BASE" Then
' el renglón de los totales
If sVG = "BASE" Then
iVezSuma = iVezSuma + 1
End If
sVG = "BASE"
iVezSuma = iVezSuma + 1
Else
If sVG = "BASE" Then
iVezSuma = iVezSuma + 1
End If
End If
If iVezSuma >= 2 Then
' se toman los totales
iVezSuma = 0
iVez = 1
sVG1 = ""
For dContador = 1 To Len(sLinea)
If Mid$(sLinea, dContador, 1) <> vbTab Then
sVG1 = sVG1 & Mid$(sLinea, dContador, 1)
Else
Exit For
End If
Next dContador
dContador = dContador + 1
sTamano = ""
sOcupado = ""
sLibre = ""
For dLargo = dContador To Len(sLinea)
If Mid$(sLinea, dLargo, 1) <> vbTab Then
If iVez = 1 Then
sTamano = sTamano & Mid$(sLinea, dLargo, 1)
End If
Else
iVez = iVez + 1
dLargo = dLargo + 1
End If
Select Case iVez
Case 2
sOcupado = sOcupado & Mid$(sLinea, dLargo, 1)
Case 3
sLibre = sLibre & Mid$(sLinea, dLargo, 1)
End Select
Next
If iVez >= 2 Then
' ya tenemos todos los datos del registro
Me.sprDatos.MaxRows = Me.sprDatos.MaxRows + 1
Me.sprDatos.Row = Me.sprDatos.MaxRows
Me.sprDatos.Col = 1
Me.sprDatos.Text = sInstancia
Me.sprDatos.Col = 2
Me.sprDatos.Value = sDia & "/" & sMesTexto & "/" & sEjercicio
Me.sprDatos.Col = 3
Me.sprDatos.Value = sVG
Me.sprDatos.Col = 4
Me.sprDatos.Value = sVG1
Me.sprDatos.Col = 5
Me.sprDatos.Value = sTamano
Me.sprDatos.Col = 6
Me.sprDatos.Value = sOcupado
Me.sprDatos.Col = 7
Me.sprDatos.Value = sLibre
Me.sprDatos.Col = 8
Me.sprDatos.Value = sBase
'sVG = vbNullString
sVG1 = vbNullString
sTamano = vbNullString
sOcupado = vbNullString
sLibre = vbNullString
iVez = 1
Me.Label1.Caption = "Registros Procesados: " & Format$(Me.sprDatos.MaxRows, "###,###,###")
DoEvents
End If
End If
Me.Label2.Caption = "Líneas Leídas: " & Format$(lLineas, "###,###,###")
DoEvents
Wend
Archivo.Close
Screen.MousePointer = vbNormal
Exit Sub
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Why Fintech is attracting so much attention from investors?

In recent years, financial technology, or "fintech" has become one of the hottest sectors in the tech world, attracting billions of dollars in investment from some of the biggest names in the business. There are a number of reasons why fintech is so...
6 respuestas

ChatGPT Polsku: Innowacyjne Rozwiązania dla Każdego w 2024

ChatGPT Polsku, w najnowszej wersji na rok 2024, oferuje użytkownikom szeroki wachlarz unikalnych funkcji, które sprawiają, że jest to niezastąpione narzędzie w codziennym życiu. Jedną z kluczowych cech, która wyróżnia tę platformę, jest jej...
5 respuestas

BUENAS identificar idioma de teclado y región

Estoy haciendo cambiando español usa y latino y este teclado me dice que tiene ñ y aparte algunas ALT no funcionan en estos dos idiomas, por favor cual idioma es y la región es un mini teclado mecánico profesional JYR TGMJR-007 quiero saber si hay o...
6 respuestas

¿Dónde puedo conseguir en formato digital la revista de National Geographic Volumen 143, No. 1, Enero 1973, versión en español?

Busco la revista National Geographic con Fecha Enero 1973, En Español, Volumen 143, No. 1.
1 respuesta

The Panda Master app is available on various platforms

The Panda Master app is available on various platforms, making it easy for users to play on the go, whether they are commuting, taking a break, or relaxing at home. Its intuitive design and user-friendly interface mean that even those who are not...
2 respuestas

Por que mi monitor se ve distinto a una Tv?

Estoy intentando comprar un Smart Tv que pueda usar como segunda pantalla para jugar con mi PC cuando quiera recostarme en el sillón. Pero no se cual comprar, ya que con distintos televisores que probe, la imagen se ve como con sombras en los...
5 respuestas

¿Cómo arreglo la pantalla de una calculadora solar?

En esta calculadora no salen los números completos. La he abierto pero no se nada del tema ni tengo soldador. Es solar y veo que dentro tiene una pila. No se si es que falla el almacenamiento, o alguna conexión ... La he tenido cargando al sol y el...
10 respuestas

When is Hosted QuickBooks Enterprise Right for Me?

QuickBooks Desktop Enterprise is a powerful locally installed program with enhanced accounting features, such as advanced inventory, advanced pricing, and QuickBooks Payroll. While it contains great features not included in its online counterpart,...
12 respuestas

Smart tv lg enciende el logo pero la pantalla se queda en negro

Smart tv lg de 47 pulgadas cinema 3d, de pronto al encenderla, solo se enciende y luego se apaga el logo pero la tv no enciende la pantalla, ¿Qué puede ser? ¿El transformador?
1 respuesta

¿Qué tipo de componentes electrónicos son estos?

Que tipo de componentes electrónicos P601, P602, P605, P606 de una fuente de alimentación son los que figuran en enlace siguiente: https://ibb.co/rMDX8Z9 Y otra pregunta, si se nota calentamiento en esa zona al estar en un color más oscuro.
2 respuestas