?? mmaketable.bas
字號:
Attribute VB_Name = "mMakeTable"
Option Compare Text
Option Explicit
Sub subInitDB()
'*** Visual Basic compatible 'CurrentDB' reference...
Dim strDbName As String
strDbName = App.Path & strUSERDB
If Dir$(strDbName) = vbNullString Then
Set ActiveDB = Nothing
If LenB(Dir$(strDbName)) <> 0 Then
On Error Resume Next
Kill strDbName
If Err <> 0 Then
'*** file could not be deleted
MsgBox APPTITLE, vbCritical, "The file" & strUSERDB & " Could not be removed." & _
vbNewLine & "Please close it and retry."
End
End If
On Error GoTo 0
End If
Set ActiveDB = DAO.CreateDatabase(strDbName, dbLangGeneral, lngDBVER)
ActiveDB.Close
Set ActiveWS = DAO.DBEngine.CreateWorkspace("myspace", "Admin", vbNullString)
DAO.DBEngine.Workspaces.Append ActiveWS
Set ActiveDB = ActiveWS.OpenDatabase(strDbName, True, False)
'*** creation of all tables
subCreateConversionTable
'*** loading the data
subLoadConversionTable
'*** set some indices
fcnMakeIDX "convert", "key"
fcnMakeIDX "convert", "original"
fcnMakeIDX "convert", "changeto"
fcnMakeIDX "convert", "iso"
Set ActiveDB = Nothing
End If
End Sub
Sub subRefreshDB()
On Error Resume Next
DAO.DBEngine.Workspaces.Delete "myspace"
On Error GoTo 0
Dim strDbName As String
strDbName = App.Path & strUSERDB
Set ActiveWS = DAO.DBEngine.CreateWorkspace("myspace", "Admin", vbNullString)
DAO.DBEngine.Workspaces.Append ActiveWS
Set ActiveDB = ActiveWS.OpenDatabase(strDbName, True, False)
End Sub
Function fcnMakeIDX(strTable As String, strField As String) As Boolean
Dim idxtemp As DAO.Index
Dim tdtemp As DAO.TableDef
On Error Resume Next
Set tdtemp = ActiveDB.TableDefs(TBL & strTable)
Set idxtemp = tdtemp.CreateIndex(IDX & strField)
With idxtemp
.Fields.Append .CreateField(FLD & strField)
If strField = "key" Then
.Unique = True
End If
End With
tdtemp.Indexes.Append idxtemp
ActiveDB.TableDefs(strTable).Indexes.Refresh
fcnMakeIDX = True
End Function
Sub subCreateConversionTable()
Dim tdTag As DAO.TableDef
Dim fldTemp As DAO.Field
With ActiveDB
Set tdTag = .CreateTableDef(TBL & "convert")
Set fldTemp = tdTag.CreateField(FLD & "key", dbLong)
fldTemp.Attributes = dbAutoIncrField Or fldTemp.Attributes
tdTag.Fields.Append fldTemp
Set fldTemp = tdTag.CreateField(FLD & "type", dbText, 255)
fldTemp.AllowZeroLength = True
tdTag.Fields.Append fldTemp
Set fldTemp = tdTag.CreateField(FLD & "original", dbText, 255)
fldTemp.AllowZeroLength = True
tdTag.Fields.Append fldTemp
Set fldTemp = tdTag.CreateField(FLD & "changeto", dbText, 255)
fldTemp.AllowZeroLength = True
tdTag.Fields.Append fldTemp
Set fldTemp = tdTag.CreateField(FLD & "description", dbMemo)
fldTemp.AllowZeroLength = True
tdTag.Fields.Append fldTemp
Set fldTemp = tdTag.CreateField(FLD & "iso", dbText, 255)
fldTemp.AllowZeroLength = True
tdTag.Fields.Append fldTemp
.TableDefs.Append tdTag
End With
Set tdTag = Nothing
End Sub
Sub subLoadConversionTable()
Dim strFileName As String
Dim rstTable As DAO.Recordset
Dim lngRecordCount As Long
Dim lngFieldcount As Long
Dim arrLine As Variant
'*** load the CSV file
strFileName = App.Path & "\" & "convert.data"
arrLine = fcnGetDelimitedRecord(fcnGetFile(strFileName))
Set rstTable = ActiveDB.OpenRecordset(TBL & "convert", dbOpenTable)
With rstTable
For lngRecordCount = 1 To arrLine(0) - 1 Step 6
.AddNew
For lngFieldcount = 1 To 5
.Fields(lngFieldcount) = (arrLine(lngRecordCount + lngFieldcount))
Next
.Fields(2) = """" & fcnGetISO(.Fields(5)) & """"
.Update
Next
.Close
End With
Set rstTable = Nothing
End Sub
Function fcnGetISO(strISO As String) As String
fcnGetISO = Chr(Val(Mid$(strISO, 4&)))
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -