Dim DataConnection As ADODB.Connection
'Dim rst As ADODB.Recordset
Dim i As Integer
Set DataConnection = New ADODB.Connection
Set rst = New ADODB.Recordset
DataConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\SansMachine.mdb " & ";Persist Security Info=False"
rst.Open "select * from Speed", DataConnection, adOpenKeyset, adLockOptimistic
Dim DataCat As ADOX.Catalog
Dim DataConnection As ADODB.Connection
Dim rs As ADODB.Recordset
Dim DataStr As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'创建传输的临时文件名FileName表
Set DataCat = New ADOX.Catalog
DataStr = "Provider=Microsoft.Jet.OLEDB.4.0;" '不能把这里的4.0改为3.51
DataStr = DataStr & "Data Source=" & App.Path & "\TempFileData.mdb"
DataCat.Create DataStr '创建数据库
DataCat.ActiveConnection = DataStr
Dim DataCat As ADOX.Catalog
Dim DataConnection As ADODB.Connection
Dim rs As ADODB.Recordset
Dim DataStr As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'创建传输的临时文件名FileName表
Set DataCat = New ADOX.Catalog
DataStr = "Provider=Microsoft.Jet.OLEDB.4.0;" '不能把这里的4.0改为3.51
DataStr = DataStr & "Data Source=" & App.Path & "\TempFileData.mdb"
DataCat.Create DataStr '创建数据库
DataCat.ActiveConnection = DataStr
Dim FileNameTable As New Table
Set FileNameTable = New ADOX.Table
FileNameTable.ParentCatalog = DataCat
FileNameTable.Name = "FileName"
'FileName表增加一个自动增长的字段(ID)
Dim col As ADOX.Column
Set col = New ADOX.Column
col.ParentCatalog = DataCat
col.Type = ADOX.DataTypeEnum.adInteger ' // 必须先设置字段类型
col.Name = "ID"
col.Properties("Jet OLEDB:Allow Zero Length").Value = False
col.Properties("AutoIncrement").Value = True
FileNameTable.Columns.Append col, ADOX.DataTypeEnum.adInteger, 0
'FileName表增加一个文本字段(传输临时文件名FileName)
Dim col2 As ADOX.Column
Set col2 = New ADOX.Column
col2.ParentCatalog = DataCat
col2.Name = "FileName"
col2.Properties("Jet OLEDB:Allow Zero Length").Value = False
FileNameTable.Columns.Append col2, ADOX.DataTypeEnum.adVarChar, 25
FileNameTable.Keys.Append "PrimaryKey", ADOX.KeyTypeEnum.adKeyPrimary, "FileName", "", "" '创建主键
DataCat.Tables.Append FileNameTable
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'创建传输的临时文件名ResultItem表
Set DataCat = New ADOX.Catalog
DataCat.ActiveConnection = DataStr
Dim ResultItemTable As New Table
Set ResultItemTable = New ADOX.Table
ResultItemTable.ParentCatalog = DataCat
ResultItemTable.Name = "ResultItem"
'ResultItem表增加一个自动增长的字段(ID)
Dim col3 As ADOX.Column
Set col3 = New ADOX.Column
col3.ParentCatalog = DataCat
col3.Type = ADOX.DataTypeEnum.adInteger ' // 必须先设置字段类型
col3.Name = "ID"
col3.Properties("Jet OLEDB:Allow Zero Length").Value = False
col3.Properties("AutoIncrement").Value = True
ResultItemTable.Columns.Append col3, ADOX.DataTypeEnum.adInteger, 0
'ResultItem表增加一个文本字段(试验方案名称TestName)
Dim col4 As ADOX.Column
Set col4 = New ADOX.Column
col4.ParentCatalog = DataCat
col4.Name = "TestName"
col4.Properties("Jet OLEDB:Allow Zero Length").Value = False
ResultItemTable.Columns.Append col4, ADOX.DataTypeEnum.adVarChar, 25
'ResultItem表增加一个文本字段(临时文件名称路径FilePath)
Dim col5 As ADOX.Column
Set col5 = New ADOX.Column
col5.ParentCatalog = DataCat
col5.Name = "FilePath"
col5.Properties("Jet OLEDB:Allow Zero Length").Value = False
ResultItemTable.Columns.Append col5, ADOX.DataTypeEnum.adVarChar, 25
'ResultItem表增加一个文本字段(临时文件名称FileName)
Dim col6 As ADOX.Column
Set col6 = New ADOX.Column
col6.ParentCatalog = DataCat
col6.Name = "FileName"
col6.Properties("Jet OLEDB:Allow Zero Length").Value = False
ResultItemTable.Columns.Append col6, ADOX.DataTypeEnum.adVarChar, 25
'ResultItem表增加一个文本字段(网络传输项名称ResultItem)
Dim col7 As ADOX.Column
Set col7 = New ADOX.Column
col7.ParentCatalog = DataCat
col7.Name = "ResultItem"
col7.Properties("Jet OLEDB:Allow Zero Length").Value = False
ResultItemTable.Columns.Append col7, ADOX.DataTypeEnum.adVarChar, 25
'ResultItem表增加一个文本字段(传输项单位(数值转换用)Unit)
Dim col8 As ADOX.Column
Set col8 = New ADOX.Column
col8.ParentCatalog = DataCat
col8.Name = "Unit"
col8.Properties("Jet OLEDB:Allow Zero Length").Value = False
ResultItemTable.Columns.Append col8, ADOX.DataTypeEnum.adVarChar, 25
'ResultItem表增加一个整型字段(传输项数值小数点位数DecDigits)
Dim col9 As ADOX.Column
Set col9 = New ADOX.Column
col9.ParentCatalog = DataCat
col9.Type = ADOX.DataTypeEnum.adSmallInt
col9.Name = "DecDigits"
col9.Properties("Jet OLEDB:Allow Zero Length").Value = False
ResultItemTable.Columns.Append col9, ADOX.DataTypeEnum.adSmallInt, 0
'ResultItem表增加一个整型字段(入库方式SendMode)
Dim col10 As ADOX.Column
Set col10 = New ADOX.Column
col10.ParentCatalog = DataCat
col10.Type = ADOX.DataTypeEnum.adSmallInt
col10.Name = "SendMode"
col10.Properties("Jet OLEDB:Allow Zero Length").Value = False
ResultItemTable.Columns.Append col10, ADOX.DataTypeEnum.adSmallInt, 0
'ResultItem表增加一个整型字段(传输方式SendDataNum)
Dim col11 As ADOX.Column
Set col11 = New ADOX.Column
col11.ParentCatalog = DataCat
col11.Type = ADOX.DataTypeEnum.adSmallInt
col11.Name = "SendDataNum"
col11.Properties("Jet OLEDB:Allow Zero Length").Value = False
ResultItemTable.Columns.Append col11, ADOX.DataTypeEnum.adSmallInt, 0
DataCat.Tables.Append ResultItemTable
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set DataCat = Nothing
'初始临时文件名表
Dim TempArray(1) As String
Dim i As Integer
TempArray(0) = "YAWData.txt"
TempArray(1) = "GJData.txt"
Set DataConnection = New ADODB.Connection
Set rs = New ADODB.Recordset
DataConnection.Open DataStr
rs.CursorLocation = adUseClient
rs.Open "FileName", DataConnection, adOpenKeyset, adLockPessimistic
For i = 0 To 1
rs.AddNew '往表中添加新记录
rs.Fields("FileName") = TempArray(i)
rs.MoveNext
Next
rs.UpdateBatch adAffectAllChapters
rs.Close
DataConnection.Close
Set rs = Nothing
Set DataConnection = Nothing
End Sub