form2-26.frm

从已标注的语料库中提取数据

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   6255
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   8355
   LinkTopic       =   "Form1"
   ScaleHeight     =   6255
   ScaleWidth      =   8355
   StartUpPosition =   3  'Windows Default
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   5640
      Top             =   4440
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.TextBox Text1 
      Height          =   855
      Left            =   600
      TabIndex        =   1
      Top             =   3000
      Width           =   2655
   End
   Begin VB.CommandButton Command1 
      Caption         =   "打开需要处理的文件夹"
      Height          =   975
      Left            =   4560
      TabIndex        =   0
      Top             =   2760
      Width           =   2775
   End
   Begin VB.Label Label2 
      Caption         =   "首先输入标点符号，然后再打开需要处理的文件夹"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   18
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1215
      Left            =   480
      TabIndex        =   3
      Top             =   600
      Width           =   6975
   End
   Begin VB.Label Label1 
      Caption         =   "输入标点符号"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   18
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   840
      TabIndex        =   2
      Top             =   2520
      Width           =   2175
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()

    
   '数据库变量定义
   Dim ws As Workspace
   Dim db As Database
   Dim NewTable As TableDef
   Dim TempTable As TableDef
   Dim NewField As Field
   Dim TempField As Field
   Dim rs As Recordset
   Dim rsTemp As Recordset
   Dim rsN As Recordset
   
   
   '其他变量定义
   Dim Y As Integer
   Dim Z As Integer
   Dim FileNames$()
   Dim str, file_newline, file_name, relname, dbname, Tempdbname As String
   Dim B, P As Integer      'S,                                      'B记录body是否存在；S记录segment是否存在；P记录标点是否在文字中出现
   Dim IDnum, Parentnum As Integer
   Dim i, j, k, num, num1, count As Integer
   
   
   '弹出对话框，选择需要打开的文件夹
   CommonDialog1.FileName = ""                                       '将文件内容清空
   CommonDialog1.MaxFileSize = 32767                                 '被打开的文件名尺寸设置为最大，即32K
   CommonDialog1.Flags = cdlOFNAllowMultiselect                      '设置文件对话框的大小
   CommonDialog1.InitDir = "e:\"                                     '设置路径
   CommonDialog1.Filter = "所有文件(*.*)|*.*"                         '设置文件过滤器
   CommonDialog1.ShowOpen                                            '显示文件对话框
   
   
    '获得文件名的过程
    '选中一个文件的情况下，CommonDialog1.FileName中的内容是路径名＋文件名
    '选中多个文件的情况下，CommonDialog1.FileName中的内容是路径名＋各个文件的名字
   CommonDialog1.FileName = CommonDialog1.FileName & Chr(32)
    Z = 1
   For i = 1 To Len(CommonDialog1.FileName)
       i = InStr(Z, CommonDialog1.FileName, Chr(32))
       If i = 0 Then Exit For
       ReDim Preserve FileNames(Y)
       FileNames(Y) = Mid(CommonDialog1.FileName, Z, i - Z)
       'Print FileNames(Y)
       Z = i + 1
       Y = Y + 1
   Next i
   
   
   
   '数据库建立工作
   ' Get default Workspace.
   Set ws = DBEngine.Workspaces(0)

   ' Make sure there isn't already a file with the name of
   ' the new database.
   If Dir(App.Path & "/ymDRcorpusdata.MDB") <> "" Then Kill App.Path & "/ymDRcorpusdata.MDB"

   ' Create a new encrypted database with the specified collating order.
   Set db = ws.CreateDatabase(App.Path & "/ymDRcorpusdata.MDB", _
      dbLangGeneral, dbEncrypt)

   '打开数据库
   Set db = Workspaces(0).OpenDatabase(App.Path & "/ymDRcorpusdata.MDB", False)

   
    
   '◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎
   num = 1                                                      '记录号
   num1 = 1
   B = 0                                                        '初始化，用来记录是否找到了body
   'S = 0                                                        '初始化，用来记录是否找到了segment
   P = 0                                                        '初始化，用来记录是否找到了标点
      
   dbname = Text1.Text
   Set NewTable = db.CreateTableDef(dbname)
   
   '加字段
   With NewTable
      ' Create fields and append them to the new TableDef
      ' object. This must be done before appending the
      ' TableDef object to the TableDefs collection of the
      ' ymDRcorpusdata.MDB database.
      .Fields.Append .CreateField("文件名", dbText)
      .Fields.Append .CreateField("记录号", dbInteger)
      .Fields.Append .CreateField("segmentid", dbInteger)
      .Fields.Append .CreateField("文字", dbText)
      .Fields.Append .CreateField("关系1", dbText)
      .Fields.Append .CreateField("核心性", dbText)
      .Fields.Append .CreateField("parentid", dbInteger)
      .Fields.Append .CreateField("关系2", dbText)
      .Fields.Append .CreateField("类型2", dbText)
      .Fields.Append .CreateField("备注", dbText)
      db.TableDefs.Append NewTable
   End With
   
   '主程序在for中进行，因为要循环处理多个文件或者单个文件
   '获得需要处理文件的过程
   '选中一个文件的情况下，FileNames()数组长度为一，主要包含路径名＋文件名
   '选中多个文件的情况下，FileNames()数组长度为文件个数＋1（路径名），主要内容是路径名、各个文件的名字
   'Print Y
   For k = 1 To Y                                               '对单个还是多个文件的处理
       file_name = ""
       If Y = 1 Then
          file_name = FileNames(0)
          'Print str
       Else
          If k = Y Then
             Exit For
          End If
          file_name = FileNames(0) & FileNames(k)
          'Print str
       End If
      
   '建立一个表ymDRcorpusdata.MDB
   'dbname = "标点" & k
   
   Tempdbname = Temp & k
   'Tempdbname = Mid(file_name, (InStrRev(file_name, "\") + 1))
   'file_name = Mid(file_name, (InStrRev(file_name, "\") + 1))  '把路径去掉
   'Print dbname
   
   Set TempTable = db.CreateTableDef(Tempdbname)
  
     
   '加字段
   With TempTable
      ' Create fields and append them to the new TableDef
      ' object. This must be done before appending the
      ' TableDef object to the TableDefs collection of the
      ' ymDRcorpusdata.MDB database.
      .Fields.Append .CreateField("文件名", dbText)
      .Fields.Append .CreateField("segmentid", dbInteger)
      .Fields.Append .CreateField("parentid", dbInteger)
      .Fields.Append .CreateField("关系1", dbText)
      
      db.TableDefs.Append TempTable
   End With
     
     
   
    '加记录
   'Set rs = db.OpenRecordset("select * from " & dbname & " where 核心性='N'")
   Set rs = db.OpenRecordset("select * from " & dbname & "")
   '"专业='" & mzy & "'"