frm_sjzh.frm

本程序是工作中开发的一个接口程序.它实现从Access数据库导出相关的数据到SQL数据库。

        Dim User_id As String
        Dim hc_Name As String
    
        Image2.Visible = True
        Currbmp = 7
        Timer1.Interval = 500
        Command4(2).Enabled = False
        Screen.MousePointer = vbHourglass
'''''        frm_dldfglxt.StatusBar1.Panels(1).Text = "正在导入数据......"

        meterdata.Open "select * from Meterdata order by Meter_ID,RTU_ID", cn, adOpenKeyset, adLockOptimistic
        If meterdata.RecordCount > 0 Then
            ProgressBar1.Visible = True
            ProgressBar1.Min = 0
            ProgressBar1.Max = meterdata.RecordCount
            
            i = 0
            meterdata.MoveFirst
            Do While Not meterdata.EOF
    '''Debug.Print meterdata!Meter_ID
    '''Debug.Print meterdata!RTU_ID
    
                i = i + 1
                ProgressBar1.Value = i

                meter.Open "select * from meter where Meter_ID='" + meterdata!Meter_ID + "' and RTU_ID=" & meterdata!RTU_ID, cn, adOpenKeyset, adLockOptimistic
                If meter.RecordCount > 0 Then
                    Curr_Base = meterdata!Curr_Base
                    User_id = meter!User_id
                    hc_Name = "hc" + Left(User_id, 5) + "00"
                    tb_Name = Left(User_id, 5) + "00"
                        
                    Set adorst = New Recordset
                    SQLString = "Select * From cbdata Where bh=" + "'" + User_id + "'"
                    adorst.Open SQLString, cn1, adOpenKeyset, adLockOptimistic
                    If adorst.EOF = False Then
                        Text1.Text = User_id
                        Text2.Text = Curr_Base
                        Bybs = Trim(Left(Curr_Base, InStr(Curr_Base, ".") + 1))
                        Text3.Text = Bybs
Debug.Print Bybs
                        adorst!bh = User_id
                        adorst!byg1 = Bybs ' Trim(Left(Curr_Base, InStr(Curr_Base, ".") - 1))
                        adorst.Update
Debug.Print asorst!byg1
                        meterdata.Delete
                        meterdata.Update
                    Else
                        Text1.Text = User_id
                        Text2.Text = Curr_Base
                        Bybs = Trim(Left(Curr_Base, InStr(Curr_Base, ".") + 1))
                        Text3.Text = Bybs
Debug.Print Bybs
                        adorst.AddNew
                        adorst!bh = User_id
                        adorst!byg1 = Bybs ' Trim(Left(Curr_Base, InStr(Curr_Base, ".") - 1))
                        adorst.Update
Debug.Print asorst!byg1
                        meterdata.Delete
                        meterdata.Update

                    End If
                    adorst.Close
                End If
                meterdata.MoveNext
                meter.Close
            Loop
            ProgressBar1.Visible = False
''''            frm_dldfglxt.StatusBar1.Panels(1).Text = "导入数据成功！"
        End If
        If meterdata.RecordCount > 0 Then
            Command4(0).Enabled = True
        
        Else
            Command4(0).Enabled = False
        End If
        meterdata.Close
        
 
        Command4(2).Enabled = True
        Timer1.Interval = 0
        Image2.Visible = False
        Screen.MousePointer = vbDefault
        
    Case 2
        cn.Close
        cn1.Close
        Unload Me
''''        frm_dldfglxt.StatusBar1.Panels(1).Text = "就绪"
        
    End Select
End Sub

Private Sub Form_Load()
'On Error GoTo error_conhandle:

Set cn = New ADODB.Connection
cn.ConnectionTimeout = 10
cn.CommandTimeout = 0
Screen.MousePointer = vbHourglass
''frm_dldfglxt.StatusBar1.Panels(1).Text = "正在连接数据库......"

''''llllconnstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + AppPath + "\NEWRTU.MDB"
connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + "C:\Program Files\载波应用\data\NEWRTU.MDB"
cn.ConnectionString = connstr
cn.Open

Set cn1 = New ADODB.Connection
cn1.CommandTimeout = 10
cn1.ConnectionString = "PROVIDER=MSDASQL;DRIVER={Microsoft Visual Foxpro Driver};SourceDB=c:\cbq\;SourceType=DBF"
cn1.Open



'''frm_dldfglxt.StatusBar1.Panels(1).Text = "就绪"
Screen.MousePointer = vbDefault
'''frm_dldfglxt.Show

Set meterdata = New Recordset
meterdata.Open "select * from meterdata", cn, adOpenKeyset, adLockOptimistic
If meterdata.RecordCount > 0 Then
    Command4(0).Enabled = True

Else
    Command4(0).Enabled = False
End If
meterdata.Close
'''frm_dldfglxt.StatusBar1.Panels(1).Text = "就绪"

Currbmp = 0

Exit Sub

error_conhandle:
Screen.MousePointer = vbDefault
If MsgBox("连接服务器数据库超时！", vbRetryCancel + vbInformation, "连接超时") = vbRetry Then
    Resume
Else
    Exit Sub
End If

    frm_dldfglxt.StatusBar1.Panels(1).Text = "就绪"
End Sub


Private Sub Form_Unload(Cancel As Integer)
Unload Me
End Sub

Private Sub Timer1_Timer()
    If Currbmp > 1 Then
        Currbmp = Currbmp - 1
    Else
        Currbmp = 7
    End If
    Image2.Picture = ImageList1.ListImages(Currbmp).Picture
End Sub


Private Sub MdbToDbf()
        Dim hcrst As Recordset
        Dim meter As Recordset
        
        Set hcrst = New Recordset
        Set meter = New Recordset
        
        Dim i As Integer
        Dim Curr_Base As Single
        Dim User_id As String
        Dim hc_Name As String
    
        Image2.Visible = True
        Currbmp = 7
        Timer1.Interval = 500
        Command4(2).Enabled = False
        Screen.MousePointer = vbHourglass
'''''        frm_dldfglxt.StatusBar1.Panels(1).Text = "正在导入数据......"

        meterdata.Open "select * from Meterdata order by Meter_ID,RTU_ID", cn, adOpenKeyset, adLockOptimistic
        If meterdata.RecordCount > 0 Then
            ProgressBar1.Visible = True
            ProgressBar1.Min = 0
            ProgressBar1.Max = meterdata.RecordCount
            
            i = 0
            meterdata.MoveFirst
            Do While Not meterdata.EOF
    '''Debug.Print meterdata!Meter_ID
    '''Debug.Print meterdata!RTU_ID
    
                i = i + 1
                ProgressBar1.Value = i

                meter.Open "select * from meter where Meter_ID='" + meterdata!Meter_ID + "' and RTU_ID=" & meterdata!RTU_ID, cn, adOpenKeyset, adLockOptimistic
                If meter.RecordCount > 0 Then
                    Curr_Base = meterdata!Curr_Base
                    User_id = meter!User_id
                    hc_Name = "hc" + Left(User_id, 5) + "00"
                    tb_Name = Left(User_id, 5) + "00"
                        
                    Set adorst = New Recordset
                    SQLString = "Select * From cbdata Where bh=" + "'" + User_id + "'"
                    adorst.Open SQLString, cn1, adOpenKeyset, adLockOptimistic
                    If adorst.EOF = False Then
                        Text1.Text = User_id
                        Text2.Text = Curr_Base
                        Bybs = Trim(Left(Curr_Base, InStr(Curr_Base, ".") - 1))
                        Text3.Text = Bybs
Debug.Print Bybs
                        adorst!bh = User_id
                        adorst!byg1 = Bybs ' Trim(Left(Curr_Base, InStr(Curr_Base, ".") - 1))
                        adorst.Update
                        meterdata.Delete
                        meterdata.Update
                    Else
                        Text1.Text = User_id
                        Text2.Text = Curr_Base
                        Bybs = Trim(Left(Curr_Base, InStr(Curr_Base, ".") - 1))
                        Text3.Text = Bybs
Debug.Print Bybs
                        adorst.AddNew
                        adorst!bh = User_id
                        adorst!byg1 = Bybs ' Trim(Left(Curr_Base, InStr(Curr_Base, ".") - 1))
                        adorst.Update
                        meterdata.Delete
                        meterdata.Update
                    End If
                    adorst.Close
                End If
                meterdata.MoveNext
                meter.Close
            Loop
            ProgressBar1.Visible = False
''''            frm_dldfglxt.StatusBar1.Panels(1).Text = "导入数据成功！"
        End If
        If meterdata.RecordCount > 0 Then
            Command4(0).Enabled = True
        
        Else
            Command4(0).Enabled = False
        End If
        meterdata.Close
        
 
        
        Command4(2).Enabled = True
        Timer1.Interval = 0
        Image2.Visible = False
        Screen.MousePointer = vbDefault
End Sub