VBA Access y resultado llevarlo a fichero plano
Publicado por rrodsal (1 intervención) el 26/04/2017 17:50:37
Buenas tardes.
He leído la última semana bastante estse foro pues neceisto de vuestra ayuda. Mis conocimientos de VBA son nulos. Os comento:
El código que pego en este mensaje genera las propiedades de las tablas de la BD Access con la que trabajo. La idea es conseguir un diccionario de datos de todas las BBDD que hay en el sistema, son más de 70. Ejecutaré este códiog una a una pues tengo que realizar cambios y añadir descripciones, etc...
La cuestión es que este código lo he generado a partir de cortar y pegar y prueba y error pero aunque en la 'venta inmediato' me aparece el resultado aparece cortado pues son muchos registros y necesito llevarmelo a Excel, o fichero plano e importarlo luego en Excel.
E nresume, si ejecuto el código el resultado neceisto llevarlo a un fichero, a poder ser Excel.
Gracias por la ayuda!!!
He leído la última semana bastante estse foro pues neceisto de vuestra ayuda. Mis conocimientos de VBA son nulos. Os comento:
El código que pego en este mensaje genera las propiedades de las tablas de la BD Access con la que trabajo. La idea es conseguir un diccionario de datos de todas las BBDD que hay en el sistema, son más de 70. Ejecutaré este códiog una a una pues tengo que realizar cambios y añadir descripciones, etc...
La cuestión es que este código lo he generado a partir de cortar y pegar y prueba y error pero aunque en la 'venta inmediato' me aparece el resultado aparece cortado pues son muchos registros y necesito llevarmelo a Excel, o fichero plano e importarlo luego en Excel.
E nresume, si ejecuto el código el resultado neceisto llevarlo a un fichero, a poder ser Excel.
Gracias por la ayuda!!!
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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
Function TableInfo(strTableName As String)
On Error GoTo TableInfoErr
' Purpose: Display the field names, types, sizes and descriptions for a table.
' Argument: Name of a table in the current database.
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim instruccion As String
Set db = CurrentDb()
Set tdf = db.TableDefs(strTableName)
Debug.Print "PATH NAME", "TABLE NAME", "FIELD NAME", "FIELD TYPE", "SIZE", "DESCRIPTION"
Debug.Print "==========", "==========", "==========", "==========", "====", "==========="
For Each fld In tdf.Fields
Debug.Print db.Name,
Debug.Print tdf.Name,
Debug.Print fld.Name,
Debug.Print FieldTypeName(fld),
Debug.Print fld.Size,
Debug.Print GetDescrip(fld)
Next
Debug.Print "==========", "==========", "==========", "====", "==========="
TableInfoExit:
Set db = Nothing
Exit Function
TableInfoErr:
Select Case Err
Case 3265& 'Table name invalid
MsgBox strTableName & " table doesn't exist"
Case Else
Debug.Print "TableInfo() Error " & Err & ": " & Error
End Select
Resume TableInfoExit
End Function
Function GetDescrip(obj As Object) As String
On Error Resume Next
GetDescrip = obj.Properties("Description")
End Function
Function FieldTypeName(fld As DAO.Field) As String
'Purpose: Converts the numeric results of DAO Field.Type to text.
Dim strReturn As String 'Name to return
Select Case CLng(fld.Type) 'fld.Type is Integer, but constants are Long.
Case dbBoolean: strReturn = "Yes/No" ' 1
Case dbByte: strReturn = "Byte" ' 2
Case dbInteger: strReturn = "Integer" ' 3
Case dbLong ' 4
If (fld.Attributes And dbAutoIncrField) = 0& Then
strReturn = "Long Integer"
Else
strReturn = "AutoNumber"
End If
Case dbCurrency: strReturn = "Currency" ' 5
Case dbSingle: strReturn = "Single" ' 6
Case dbDouble: strReturn = "Double" ' 7
Case dbDate: strReturn = "Date/Time" ' 8
Case dbBinary: strReturn = "Binary" ' 9 (no interface)
Case dbText '10
If (fld.Attributes And dbFixedField) = 0& Then
strReturn = "Text"
Else
strReturn = "Text (fixed width)" '(no interface)
End If
Case dbLongBinary: strReturn = "OLE Object" '11
Case dbMemo '12
If (fld.Attributes And dbHyperlinkField) = 0& Then
strReturn = "Memo"
Else
strReturn = "Hyperlink"
End If
Case dbGUID: strReturn = "GUID" '15
'Attached tables only: cannot create these in JET.
Case dbBigInt: strReturn = "Big Integer" '16
Case dbVarBinary: strReturn = "VarBinary" '17
Case dbChar: strReturn = "Char" '18
Case dbNumeric: strReturn = "Numeric" '19
Case dbDecimal: strReturn = "Decimal" '20
Case dbFloat: strReturn = "Float" '21
Case dbTime: strReturn = "Time" '22
Case dbTimeStamp: strReturn = "Time Stamp" '23
'Constants for complex types don't work prior to Access 2007 and later.
Case 101&: strReturn = "Attachment" 'dbAttachment
Case 102&: strReturn = "Complex Byte" 'dbComplexByte
Case 103&: strReturn = "Complex Integer" 'dbComplexInteger
Case 104&: strReturn = "Complex Long" 'dbComplexLong
Case 105&: strReturn = "Complex Single" 'dbComplexSingle
Case 106&: strReturn = "Complex Double" 'dbComplexDouble
Case 107&: strReturn = "Complex GUID" 'dbComplexGUID
Case 108&: strReturn = "Complex Decimal" 'dbComplexDecimal
Case 109&: strReturn = "Complex Text" 'dbComplexText
Case Else: strReturn = "Field type " & fld.Type & " unknown"
End Select
FieldTypeName = strReturn
End Function
Public Sub ShowTableFields()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Set db = CurrentDb
For Each tdf In db.TableDefs
' ignore system and temporary tables
If Not (tdf.Name Like "MSys*" Or tdf.Name Like "~*") Then
TableInfo (tdf.Name)
End If
Next
Set tdf = Nothing
Set db = Nothing
End Sub
Valora esta pregunta
0