Access - Importar txt

   
Vista:
Imágen de perfil de Francesc

Importar txt

Publicado por Francesc (61 intervenciones) el 11/10/2012 20:32:09
Buenos dias,
Necesito ayuda si és ello posible, supongo que si pero mi conocimiento de código es nulo. Utilizando los recursos de Access 2010 consigo automatizar la importación de texto a tablas con el siguiente código:
Private Sub Comando6_Click()
'Function McrImportartxt()
On Error GoTo Err_Comando6_Click

DoCmd.SetWarnings False
DoCmd.TransferText acImportFixed, "TblText_X22", "TblText_X22", "D:\Datos\Mis documentos\My eBooks\ArxiuSumat.txt", False, ""
DoCmd.TransferText acImportFixed, "TblText_x55", "TblText_x55", "D:\Datos\Mis documentos\My eBooks\ArxiuSumat.txt", False, ""
DoCmd.TransferText acImportFixed, "TblText_x88", "TblText_x88", "D:\Datos\Mis documentos\My eBooks\ArxiuSumat.txt", False, ""
DoCmd.SetWarnings True

Exit_Comando6_Click:
'Exit Function
Exit Sub

Err_Comando6_Click:
MsgBox Err.Description
Resume Exit_Comando6_Click
'End Function
End Sub

El problema que tengo es que son unos 40 ficheros a procesar y no consigo automatizarlo, debo de hacerlo uno a uno y además al registrarlo en las tablas necesito incorporar el nombre del fichero de texto.
¿Es ello posible? Agradezco la ayuda.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

Importar txt

Publicado por deneg_nhj (349 intervenciones) el 11/10/2012 20:58:30
1. Crea una tabla con 2 campos, en uno de ellos vas a poner el nombre de los archivos y en el otro un campo de marcaje.
2. Realiza un rutina para leer los archivos de texto. Esta rutina debe de hacer un ciclo para cada uno de los archivos de texto que existan en un directorio "donde están tus txt"


3.- Realiza otro ciclo, donde recorras la tabla que llenaste y ejecuta por cada registro el proceso de importar, en este ciclo debes de ejecutar una consulta para actualizar el nombre del archivo, que ya lo tienes en la tabla del paso.

Listo!!!

www.sgh.com.mx
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Importar txt

Publicado por deneg_nhj (349 intervenciones) el 11/10/2012 21:00:22
Aquí esta la rutina del paso No. 2


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Private Sub LeerArchivos(smptRuta As String)
 
Dim sArchivo As String
'Dim sRuta  As String
 
DoCmd.SetWarnings (False)
DoCmd.RunSQL "DELETE * FROM tbArchivos", False
DoCmd.SetWarnings (True)
 
 
Set tbArchivos = CurrentDb.OpenRecordset("tbArchivos")
 
sRuta = smptRuta
 
sArchivo = Dir(sRuta & "*.txt")     ' Recupera la primera entrada.
Do While sArchivo <> ""     ' Inicia el bucle.
 
    tbArchivos.AddNew
    tbArchivos.Fields("sArchivo") = sArchivo
    tbArchivos.Update
 
    sArchivo = Dir    ' Obtiene siguiente entrada.
Loop
 
End Sub
'==================================================



www.sgh.com.mx
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Importar txt

Publicado por deneg_nhj (349 intervenciones) el 11/10/2012 21:06:11
Este es el boceto para el tercer paso


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub sImporta(smptRuta As String)
Dim i As Long
 
 
tbArchivos.MoveFirst
 
While tbArchivos.EOF = False
 
' ---------- Aqui procesar los imports, por cada uno de los archivos ------------
 
DoCmd.TransferText acImportFixed, "TblText_x88", "TblText_x88", "D:\Datos\Mis documentos\My eBooks\ArxiuSumat.txt", False, ""
 
 
' ---------- Aqui procesar los imports, por cada uno de los archivos ------------
 
docmd.runsql ("update   Todos  SET ArchivoOrig = "  & tbArchivos.fields("Archivo") " " )
 
 
    tbArchivos.MoveNext
Wend
 
 
end sub



Esto aun tienes que adecuarlo, pero ya esta casi listo!!!!!!!!!!!

Saludos!
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de Francesc

Importar txt

Publicado por Francesc (61 intervenciones) el 12/10/2012 20:43:58
Sin ningún problema con tu ayuda he resuelto los puntos 1 y 2 pero en el 3 no consigo escribir nada que funcione. Mi nivel de código es muy limitado. Puedes echarme una mano casi como si fuera un niño de parvulario.
Gracias y saludos,
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de Francesc

Importar txt

Publicado por Francesc (61 intervenciones) el 13/10/2012 09:40:14
Adjunto el código que me tiene liado y no consigo que funcione,

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
private Sub Comando21_Click()
On Error GoTo Err_Comando21_Click
Dim bytArchivo As Byte, _
    strRutaArchivo As String, _
    strArchivo As String, _
    strLinea As String, _
    strSQL As String, _
    lngLinea As Long, _
    Contador As Long, Cuenta As Long
Dim Iniciales As String, Cadena As Long
Dim RutaFichero As String, PrimeraIni As String
    'Me.EtiEspera.Visible = True
    'Me.NomArchivo.Visible = True
    'Me.txtStatusBar.Visible = True
    'Me.txtStatusPercent.Visible = True
    'NomArchivo = Null 'En este caso es un campo independiente, pero puede ser una variable pública
    strRutaArchivo = "D:\Datos\Mis documentos\My eBooks\"
    strArchivo = Dir(strRutaArchivo & "*.txt")
    Contador = 0
    Cuenta = 0
  'Cuento los archivosde texto
  Do While strArchivo <> ""
      PrimeraIni = Left(strArchivo, 1)
      strArchivo = strRutaArchivo & strArchivo
      strArchivo = Dir
      Contador = Contador + 1
    If PrimeraIni = "M" Then
      Cuenta = Cuenta + 1
    Else
      Cuenta = Cuenta
    End If
  Loop
    CantArchivos = Contador
    CantMax = Cuenta
 
    strArchivo = Dir(strRutaArchivo & "*.txt")
    'DoCmd.SetWarnings False
 'For CantArchivos = 0 To CantArchivos
    'Cadena = Len(FileName(strRutaArchivo & strArchivo)) - 4
    'NomArchivo = UCase(Left(FileName(strArchivo), Cadena))
    'Iniciales = UCase(Right(Left(FileName(strArchivo), 3), 2))
    'bytArchivo = FreeFile
 If strArchivo <> "." And strArchivo <> ".." And Right(strArchivo, 3) = "txt" And Left(strArchivo, 1) = "M" Then
 strArchivo = strRutaArchivo & strArchivo
    'DoCmd.OpenQuery "CnsExportarExcelEliminar"
 
Open strArchivo For Input As #bytArchivo 'Recorrida para insertar en las tablas
 Do While Not EOF(bytArchivo)
  DoCmd.SetWarnings False
    DoCmd.TransferText acImportFixed, "TblText_X88", "TblText_X88", "strArchivo & NomArchivo", False, """"
    DoCmd.TransferText acImportFixed, "TblText_X78", "TblText_X78", "strArchivo & NomArchivo", False, """"
    DoCmd.TransferText acImportFixed, "TblText_X68", "TblText_X68", "strArchivo & NomArchivo", False, """"
    DoCmd.TransferText acImportFixed, "TblText_X58", "TblText_X58", "strArchivo & NomArchivo", False, """"
    DoCmd.TransferText acImportFixed, "TblText_X48", "TblText_X48", "strArchivo & NomArchivo", False, """"
    DoCmd.SetWarnings True
 Loop
    Close #bytArchivo
    FileCopy strRutaArchivo & NomArchivo & ".txt", "D:\Datos\Mis documentos\My eBooks\Fitxers\" & NomArchivo & ".txt"
    Kill strRutaArchivo & NomArchivo & ".txt"
    strArchivo = Dir
 
 ElseIf strArchivo <> "." And strArchivo <> ".." And Right(strArchivo, 3) = "txt" Then
    strArchivo = strRutaArchivo & strArchivo
    strArchivo = Dir
 End If
    If Left(NomArchivo, 1) = "M" Then
      DoEvents
      Avanzar
    End If
 'Next CantArchivos
  '  Me.EtiProceso.Visible = True
   ' Resetear
    'DoCmd.SetWarnings True
Exit_Comando21_Click:
    Exit Sub
Err_Comando21_Click:
    MsgBox Err.Description
    Resume Exit_Comando21_Click
End Sub
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Importar txt

Publicado por deneg_nhj (349 intervenciones) el 13/10/2012 14:49:48
Aquí esta la modificación del 3er paso. No lo probe puesto que no tengo los archivos. Pero debería de funcionar sin problemas.


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub sImporta(smptRuta As String)
Dim i As Long
 
' -------------- NOTA, NOTA, NOTA -------------- 
'Debes de crear una tabla llamada "tbFinal", que debe de tener la misma estructura que los archivos que estas inportando y al FINAL,  le agragas un campo llamado "sNomArchivo" de tipo texto.
' -------------- NOTA, NOTA, NOTA -------------- 
 
 
sRuta = "D:\Datos\Mis documentos\My eBooks\"
tbArchivos.MoveFirst
 
While tbArchivos.EOF = False
 
' ---------- Aqui procesar los imports, por cada uno de los archivos ------------
DoCmd.TransferText acExportFixed, "TblText_x88", "e_" & tbArchivos.Fields("sArchivo"), sRuta &  tbArchivos.Fields("sArchivo"), False, ""
 
 
' ---------- Aqui procesar los imports, por cada uno de los archivos ------------	
	dbs.Execute "ALTER TABLE e_" & tbArchivos.Fields("sArchivo") & "  ADD COLUMN sNomArchivo;"
	dbs.Execute "UPDATE TABLE e_" & tbArchivos.Fields("sArchivo") & "  SET sNomArchivo = '" & tbArchivos.Fields("sArchivo") & "'"
	dbs.Execute "INSERT INTO tbFinal SELECT * FROM e_" & tbArchivos.Fields("sArchivo")
 
 
    tbArchivos.MoveNext
Wend
 
 
end sub



Saludos!

http://www.sgh.com.mx/hjaservicios.html
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar
Imágen de perfil de Francesc

Importar txt

Publicado por Francesc (61 intervenciones) el 01/11/2012 09:46:50
Buenos dias, deneg_nhj,

Lamento mi mala educación en no contestar pero de la emoción de verlo funcionar se me paso agradecerte tu enorme ayuda. Muchas gracias,

Saludos,
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar