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
| Public Function CreateSchemaFile(bIncFldNames As Boolean, sPath As String, sSectionName As String, sTblQryName As String) As Boolean
Dim Msg As String ' For error handling.
On Local Error GoTo CreateSchemaFile_Err
Dim ws As Workspace, db As DAO.Database
Dim tblDef As DAO.TableDef, fldDef As DAO.Field
Dim i As Integer, Handle As Integer
Dim fldName As String, fldDataInfo As String
Set db = CurrentDb()
Handle = FreeFile
Open sPath & "schema.ini" For Output Access Write As #Handle
Print #Handle, "[" & sSectionName & "]"
Print #Handle, "ColNameHeader =" & IIf(bIncFldNames, "True", "False")
Print #Handle, "Format=FixedLength"
Print #Handle, "MaxScanRows=0"
Print #Handle, "CharacterSet=OEM"
Set tblDef = db.TableDefs(sTblQryName)
With tblDef
For i = 0 To .Fields.Count - 1
Set fldDef = .Fields(i)
With fldDef
fldName = .Name
Select Case .Type
Case dbBoolean
fldDataInfo = "Bit"
Case dbByte
fldDataInfo = "Byte"
Case dbInteger
fldDataInfo = "Short"
Case dbLong
fldDataInfo = "Integer"
Case dbCurrency
fldDataInfo = "Currency"
Case dbSingle
fldDataInfo = "Single"
Case dbDouble
fldDataInfo = "Double"
Case dbDate
fldDataInfo = "Date Width " & Format$(.Size)
Case dbText
fldDataInfo = "Char Width " & Format$(.Size)
Case dbLongBinary
fldDataInfo = "OLE"
Case dbMemo
fldDataInfo = "LongChar"
Case dbGUID
fldDataInfo = "Char Width 16"
End Select
Print #Handle, "Col" & Format$(i + 1) & "=" & Chr(34) & fldName & Chr(34) & Space$(1) & fldDataInfo
End With
Next i
End With
MsgBox sPath & "SCHEMA.INI has been created."
CreateSchemaFile = True
CreateSchemaFile_End:
Close Handle
Exit Function
CreateSchemaFile_Err:
Msg = "Error #: " & Format$(Err.Number) & vbCrLf
Msg = Msg & Err.Description
MsgBox Msg
Resume CreateSchemaFile_End
End Function
Function CreateSchemaFromTable(ProjectPath As String, sSectionName As String, SourceTableName As String)
'ProjectPath - Path of database
'ProjectPath - Path of database
'sSectionName - Schema.ini section name; must be the same as the name of the text file it describes
'SourceTableName - Name of the table or query for which you want to create a Schema.ini file
CreateSchemaFile True, ProjectPath & "\", sSectionName, SourceTableName
End Function |
Partager