form1.frm

读取我word文件中的表格中的字段并产生数据表

VERSION 5.00
Object = "{E2D000D0-2DA1-11D2-B358-00104B59D73D}#1.0#0"; "titext8.ocx"
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   4200
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8445
   LinkTopic       =   "Form1"
   ScaleHeight     =   4200
   ScaleWidth      =   8445
   StartUpPosition =   3  '窗口缺省
   Begin MSAdodcLib.Adodc Adodc1 
      Height          =   330
      Left            =   990
      Top             =   3255
      Width           =   2055
      _ExtentX        =   3625
      _ExtentY        =   582
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   8
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   ""
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   ""
      Caption         =   "Adodc1"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin TDBText6Ctl.TDBText Text1 
      Height          =   2190
      Left            =   915
      TabIndex        =   0
      Top             =   675
      Width           =   6240
      _Version        =   65536
      _ExtentX        =   11007
      _ExtentY        =   3863
      Caption         =   "Form1.frx":0000
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      DropDown        =   "Form1.frx":0063
      Key             =   "Form1.frx":0081
      BackColor       =   -2147483643
      EditMode        =   0
      ForeColor       =   -2147483640
      ReadOnly        =   0
      ShowContextMenu =   0
      MarginLeft      =   1
      MarginRight     =   1
      MarginTop       =   1
      MarginBottom    =   1
      Enabled         =   -1
      MousePointer    =   0
      Appearance      =   0
      BorderStyle     =   1
      AlignHorizontal =   0
      AlignVertical   =   0
      MultiLine       =   -1
      ScrollBars      =   0
      PasswordChar    =   ""
      AllowSpace      =   -1
      Format          =   ""
      FormatMode      =   1
      AutoConvert     =   -1
      ErrorBeep       =   0
      MaxLength       =   0
      LengthAsByte    =   0
      Text            =   ""
      Furigana        =   0
      HighlightText   =   0
      IMEMode         =   0
      IMEStatus       =   0
      DropWndWidth    =   0
      DropWndHeight   =   0
      ScrollBarMode   =   0
      MoveOnLRKey     =   0
      OLEDragMode     =   0
      OLEDropMode     =   0
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private objWordTable As Word.Table
Private objWordDoc As Word.Document
Private objWord As Word.Application

Private Sub CreateTable(sName As String, vData() As Variant)
'// ***
'// 創建表格
'// ***
    Dim tblNew As New ADOX.Table
    Dim objAdox As New ADOX.Catalog
    Dim intCount As Integer
    
    objAdox.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\0-JackFile\02-懷念齋\02-物流系統\TC-WMS60\01-系統設計\1.mdb;Persist Security Info=False"
    
    tblNew.Name = sName
    
    For intCount = 0 To UBound(vData, 1)
        Select Case CStr(vData(intCount, 2))
            Case "C"
                If Trim$(vData(intCount, 3)) = "" Then
                    tblNew.Columns.Append CStr(vData(intCount, 0)), adVarWChar
                Else
                    tblNew.Columns.Append CStr(vData(intCount, 0)), adVarWChar, CInt(vData(intCount, 3))
                End If
                
            Case "V"
                If Trim$(vData(intCount, 3)) = "" Then
                    tblNew.Columns.Append CStr(vData(intCount, 0)), adVarWChar
                Else
                    tblNew.Columns.Append CStr(vData(intCount, 0)), adVarWChar, CInt(vData(intCount, 3))
                End If

            Case "N"
                If Trim$(vData(intCount, 3)) = "" Then
                    tblNew.Columns.Append CStr(vData(intCount, 0)), adInteger
                Else
                    tblNew.Columns.Append CStr(vData(intCount, 0)), adInteger, CInt(vData(intCount, 3))
                End If

            Case "D"
                If Trim$(vData(intCount, 3)) = "" Then
                    tblNew.Columns.Append CStr(vData(intCount, 0)), adDate
                Else
                    tblNew.Columns.Append CStr(vData(intCount, 0)), adDate, CInt(vData(intCount, 3))
                End If

            Case Else
                If Trim$(vData(intCount, 3)) = "" Then
                    tblNew.Columns.Append CStr(vData(intCount, 0)), adVarWChar
                Else
                    tblNew.Columns.Append CStr(vData(intCount, 0)), adVarWChar, CInt(vData(intCount, 3))
                End If
                
        End Select
    
    Next intCount
    objAdox.Tables.Append tblNew
    
     ' tblNew(vData(Count, 0)).Properties("Description").Value = CStr(vData(intCount, 1))
End Sub

Private Function UpdtText(sText As String) As String
    Dim fldFF As Fields
      
End Function



Private Sub Form_Load()
    Dim intRows As Integer
    Dim intColumns As Integer
    Dim intTable As Integer
    Dim intRowCount As Integer
    Dim intColCount As Integer
    
    Dim strText As String
    Dim strTable As String
    Dim varStr() As Variant '字段

    Text1 = ""
    Set objWord = New Word.Application

    Set objWordDoc = objWord.Documents.Open("D:\0-JackFile\02-懷念齋\02-物流系統\TC-WMS60\02-數據字典\03-系統設置\03-系統功能管理表.doc")
    
    For intTable = 2 To objWordDoc.Tables.Count
        Set objWordTable = objWordDoc.Tables(intTable)
        strTable = Left(Trim$(objWordTable.Cell(4, 2).Range.Text), Len(objWordTable.Cell(4, 2).Range.Text) - 2)
        ReDim varStr(objWordTable.Rows.Count - 9, 3)
        intColCount = 0
        
        For intRows = 9 To objWordTable.Rows.Count
            intRowCount = 0
            For intColumns = 2 To 5
                strText = Left(Trim$(objWordTable.Cell(intRows, intColumns).Range.Text), Len(objWordTable.Cell(intRows, intColumns).Range.Text) - 2)
                varStr(intColCount, intRowCount) = strText
                intRowCount = intRowCount + 1
            Next intColumns
'            Text1 = Trim$(Left(Text1, Len(Text1) - 1)) & Chr(13)
            intColCount = intColCount + 1
        Next intRows
        CreateTable strTable, varStr
    Next intTable
    
    Set objWordDoc = objWord.Documents.Close
    Me.Show
End Sub