createbas.bas

几个不错的VB例子

Attribute VB_Name = "CreateBAS"
'{ -------------------------------[  NiKroWare  ]-------------------------------
'$Archive:: /Visual Basic/NKW/NKWCreateMDB/CreateBAS.bas                       $
'$Author:: Enik                                                                $
'$Date:: 10-08-01 11:22                                                        $
'$Modtime:: 8-08-01 12:55                                                      $
'$Revision:: 4                                                                 $
'-------------------------------------------------------------------------------

Option Explicit

Public mCon As ADODB.Connection
Public mCat As ADOX.Catalog

Public DB_Name As String
Public DB_Title As String

' Engine Type = 4 creates an Access database in 3.5 format
' Engine Type = 5 creates an Access database in 4.0 format  (default)

' Note, Access 97 will not be able to open up an Access 2000 database.
' However, Access 2000 will be able to open up an Access 97 or 2000 database.
' If 97 database, then Access 2000 will ask you if you want to convert to a 2000
' database format, or just  open it read-only.

' oCat.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
'                     "Data Source=c:\temp\new35.mdb;" & _
'                     "Jet OLEDB:Engine Type=5;"


Public Enum EngineTypeEnum
  adAccess35 = 4
  adAccess40 = 5
End Enum

Public Function SplitString(ByVal Str As String) As String
' vb has a 1024 char per line limit and it will not split lines nicely

Dim x As Integer, y As Integer
Const SP As Integer = 80 ' split pos

Dim sTemp() As String

  If Len(Str) > SP Then
    y = (Len(Str) \ SP)
    ReDim sTemp(y)
     
    For x = 0 To y
      sTemp(x) = Mid$(Str, (x * SP) + 1, SP)
    Next x
    
    For x = LBound(sTemp) To UBound(sTemp)
      SplitString = SplitString & sTemp(x)
      If x < UBound(sTemp) Then SplitString = SplitString & """ & _" & vbCrLf & vbTab & """"
    Next x

    Erase sTemp
      
  Else
    SplitString = Str
  End If


End Function

Public Sub CreateModule(ByVal FileName As String, Optional ByVal EngineType As EngineTypeEnum = adAccess35)
Dim fHandle As Integer
On Error GoTo ErrTrap
  
  fHandle = FreeFile
  
  Open FileName For Output As #fHandle
  
  WriteHeader fHandle
  
  WriteDB fHandle, EngineType
  CreateTables fHandle
  CreateViews fHandle
  CreateProcedures fHandle
  CreateIndexes fHandle
  CreateKeys fHandle
  
  Close fHandle

Exit Sub
ErrTrap:
  MsgBox Err.Number & " / " & Err.Description, vbExclamation, "Error in CreateModule"
  Close fHandle
  Exit Sub
  Resume
End Sub

Private Sub WriteHeader(ByVal fHandle As Integer)
  
  Print #fHandle, "Attribute VB_Name = ""Create" & Replace(DB_Title, ".mdb", "") & """"
  Print #fHandle, "Option Explicit"
  Print #fHandle, ""
  Print #fHandle, "' ========================================================"
  Print #fHandle, "' === Generator       : CreateMDB v" & App.Major & "." & Format$(App.Minor, "00") & "." & Format$(App.Revision, "0000")
  Print #fHandle, "' === Copyright