form1.frm
来自「access to oracle 数据库的方法例子,希望大家指正」· FRM 代码 · 共 398 行
FRM
398 行
VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 10695
ClientLeft = 60
ClientTop = 345
ClientWidth = 14970
LinkTopic = "Form1"
ScaleHeight = 10695
ScaleWidth = 14970
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command2
Caption = "send"
Height = 675
Left = 1260
TabIndex = 5
Top = 8100
Width = 2475
End
Begin MSAdodcLib.Adodc Adodc2
Height = 615
Left = 0
Top = 5520
Visible = 0 'False
Width = 1935
_ExtentX = 3413
_ExtentY = 1085
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 = "Provider=MSDAORA.1;Password=gdcy;User ID=gjjm;Data Source=server;Persist Security Info=True"
OLEDBString = "Provider=MSDAORA.1;Password=gdcy;User ID=gjjm;Data Source=server;Persist Security Info=True"
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = "select * from reportDay_gd"
Caption = "Adodc2"
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 VB.TextBox Text1
Height = 1935
Left = 60
MultiLine = -1 'True
TabIndex = 2
Top = 5580
Width = 14475
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 495
Left = 6840
TabIndex = 1
Top = 7080
Width = 1335
End
Begin MSDataGridLib.DataGrid DataGrid1
Bindings = "Form1.frx":0000
Height = 4935
Left = 240
TabIndex = 0
Top = 360
Width = 14355
_ExtentX = 25321
_ExtentY = 8705
_Version = 393216
AllowUpdate = -1 'True
HeadLines = 1
RowHeight = 14
AllowAddNew = -1 'True
AllowDelete = -1 'True
BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ColumnCount = 2
BeginProperty Column00
DataField = ""
Caption = ""
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column01
DataField = ""
Caption = ""
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
SplitCount = 1
BeginProperty Split0
BeginProperty Column00
EndProperty
BeginProperty Column01
EndProperty
EndProperty
End
Begin MSAdodcLib.Adodc Adodc1
Height = 375
Left = 4440
Top = 120
Visible = 0 'False
Width = 2055
_ExtentX = 3625
_ExtentY = 661
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 = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=G:\AccessToOracle\上传数据.mdb;Persist Security Info=False"
OLEDBString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=G:\AccessToOracle\上传数据.mdb;Persist Security Info=False"
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = "select * from main_gd"
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 VB.Label Label3
Caption = "Label3"
Height = 915
Left = 4500
TabIndex = 6
Top = 7860
Width = 4155
End
Begin VB.Label Label2
Caption = "传送后的数据"
DataSource = "Adodc1"
Height = 375
Left = 240
TabIndex = 4
Top = 5520
Width = 6735
End
Begin VB.Label Label1
Caption = "原始数据"
DataSource = "Adodc1"
Height = 375
Left = 1080
TabIndex = 3
Top = 60
Width = 6735
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command2_Click()
Call send_record_fun
If ErrNumber = 4 Then
Label3.Caption = "服务器连接错误"
Label3.ForeColor = vbRed
Label3.Visible = True
Else
Label3.Visible = False
End If
End Sub
Private Sub Form_Load()
'Dim MyDb As Database '定义了一个数据库对象变量
'Dim MyWs As Workspace '定义了一个工作空间对象变量
'Dim MyTb As TableDef '定义了一个表对象变量
'Dim MyRs As Recordset '定义了一个记录集变量
'Dim MyFd As Field '定义了一个字段变量
'Dim AuIdx As Index '定义了一个索引
''''''Dim newRSTa As ADODB.Recordset
''''''Dim newRSTo As ADODB.Recordset
''''''Dim str As String
''''''
''''''Dim msgText As String
''''''Dim strSQL As String
''''''Dim re As SendType
''''''Dim recount
''''''
''''''
'''''''Dim rq, sj As String
'''''''Dim yw, sw, yh, hsl, yl, sl As Double
'''''''连接到数据库的待上传数据库
'''''''str = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:\AccessToOracle\上传数据.mdb;Persist Security Info=False"
''''''
''''''str = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\上传数据.mdb;Persist Security Info=False"
''''''
''''''strSQL = "select * from main_gd"
''''''Set newRSTa = ExecuteSQL(strSQL, msgText, str)
''''''recount = newRSTa.RecordCount
''''''If newRSTa.RecordCount >= 1 Then '如果数据个数不是0 则传输
''''''
''''''str = "Provider=MSDAORA.1;Password=gdcy;User ID=gjjm;Data Source=server;Persist Security Info=True"
''''''Do While Not newRSTa.EOF
''''''re.zh = newRSTa.Fields.Item("站号")
''''''re.gh = newRSTa.Fields.Item("罐号")
''''''re.rq = Format(newRSTa.Fields.Item("日期"), "yyyy-mm-dd")
''''''re.sj = Format(newRSTa.Fields.Item("时间"), "hh:mm:ss")
''''''re.yw = newRSTa.Fields.Item("液位")
''''''re.sw = newRSTa.Fields.Item("水位")
''''''re.yh = yw - sw
''''''re.hsl = newRSTa.Fields.Item("含水率")
''''''If IsNull(hsl) Then
''''''re.hsl = 0
''''''End If
''''''re.yl = newRSTa.Fields.Item("油量")
''''''re.sl = newRSTa.Fields.Item("水量")
''''''strSQL = "insert into main_gd values ('" & re.zh & "','" & re.gh & "','" & re.rq & "','" & re.sj & _
''''''"'," & re.yw & "," & re.sw & "," & re.yh & "," & re.hsl & "," & re.yl & "," & re.sl & ")"
''''''Text1.Text = strSQL
''''''Set newRSTo = ExecuteSQL(strSQL, msgText, str)
''''''
'''''''If Err.Description <> Null Then
''''''newRSTa.Delete
'''''' newRSTa.MoveNext
''''''
''''''' End If
''''''Loop
''''''End If
End Sub
Function send_record_fun()
Dim cnn As ADODB.Connection
Dim re As SendType
Dim strSQL As String
Dim newRSTa As ADODB.Recordset
Dim newRSTo As ADODB.Recordset
Dim msgText As String
Dim recount
'检测文件是否存在
Dim filename As String
Dim mystr As String
ErrNumber = 0
filename = App.Path & "\上传数据.mdb"
mystr = Dir$(filename, vbDirectory)
If mystr = "" Then
'么有记录文件推出传送程序
ErrNumber = 1
Exit Function
End If
'监测文件记录不为零继续，否则退出
mystr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\上传数据.mdb;Persist Security Info=False"
strSQL = "select * from main_gd"
Set newRSTa = ExecuteSQL(strSQL, msgText, mystr)
recount = newRSTa.RecordCount
If newRSTa.RecordCount < 1 Then '如果数据个数不是0 则传输
Set newRSTa = Nothing
ErrNumber = 2
Exit Function
End If
mystr = "Provider=MSDAORA.1;Password=gdcy;User ID=gjjm;Data Source=server;Persist Security Info=True"
Do While Not newRSTa.EOF
re.zh = Trim(newRSTa.Fields.Item("站号"))
re.gh = Trim(newRSTa.Fields.Item("罐号"))
re.rq = Trim(Format(newRSTa.Fields.Item("日期"), "yyyy-mm-dd"))
re.sj = Trim(Format(newRSTa.Fields.Item("时间"), "hh:nn:ss"))
re.yw = newRSTa.Fields.Item("液位")
re.sw = newRSTa.Fields.Item("水位")
re.yh = newRSTa.Fields.Item("油厚")
re.hsl = newRSTa.Fields.Item("含水率")
If IsNull(hsl) Then
re.hsl = 0
End If
re.yl = newRSTa.Fields.Item("油量")
re.sl = newRSTa.Fields.Item("水量")
strSQL = "insert into main_gd values ('" & re.zh & "','" & re.gh & "','" & re.rq & "','" & re.sj & _
"'," & re.yw & "," & re.sw & "," & re.yh & "," & re.hsl & "," & re.yl & "," & re.sl & ")"
Set newRSTo = ExecuteSQL(strSQL, msgText, mystr)
If ErrNumber <> 0 Then
Exit Do
Else
newRSTa.Delete
newRSTa.MoveNext
End If
Loop
Set newRSTo = Nothing
Set nwrsta = Nothing
End Function
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?