多个记录插入到sql数据库中,仅对某些记录具有相同的值

时间:2015-04-28 11:03:08

标签: sql-server vba vb6 batch-processing

这是我的代码,当我们单击按钮时,此代码正在运行,但问题是某些记录会为记录创建重复行。而且我们无法从创建此重复的地方获取

Option Explicit

Dim sg_conn As New ADODB.Connection
Dim arsProduct_M As New ADODB.Recordset
Dim arsProduct As New ADODB.Recordset
Dim Receiving_Rec As New ADODB.Recordset
Dim str As String
Dim mservice_order_status As String
Dim mStop As Boolean
Dim mkit_orderstatus As String
Dim mdatetime As String
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub cmdstop_Click()
    mStop = True
    svr_stk_avl_routine.mStop = True
End Sub

Private Sub Form_Initialize()
    On Error GoTo error_handle

    Dim str86 As String
    Dim whseid_rst As New ADODB.Recordset
    Dim mtot_count As Double
    Dim mstart_time As Date

    If App.PrevInstance = True Then
        End
    End If

    mStop = False
    comm.CommandTimeout = 800
    comm.CommandType = adCmdText
    comm.Prepared = False

    ser_stk_avl_routine.Show

    DoEvents
    mstart_time = Format(Now, "MM-DD-YYYY HH:MM:SS")
    If mStop = True Then GoTo error_handle
    Call sg_open_connection

    If Hour(Now) >= 6 And Hour(Now) <= 18 Then
        '[AW] UAT

         str86 = "Select Service_Order_Header.PK_Num_Service_Ord_No, Service_Order_Header.Whseid " & _
                 " from Service_Order_Header as Service_Order_Header with (nolock)" & _
                 " Where PK_Num_Service_Ord_No = '84902189820' and " & _
                 " chr_status in ('U','W','H') and var_deliverable <> 'PFR(YJPOW)' and " & _
                 " other_hubs is null "

    Else
         str86 = "Select Service_Order_Header.PK_Num_Service_Ord_No, Service_Order_Header.Whseid " & _
                 " from Service_Order_Header as Service_Order_Header with (nolock)" & _
                 " Where PK_Num_Service_Ord_No = '84902189820' and " & _
                 " chr_status in ('U','W','H') and var_deliverable <> 'PFR(YJPOW)' and " & _
                 " other_hubs is null "
    End If

    whseid_rst.Open str86, sg_conn, adOpenStatic, adLockReadOnly
    mtot_count = whseid_rst.RecordCount

    Do Until whseid_rst.EOF
        ser_stk_avl_routine.Text1.Text = "Checking Stock for Unfulfilled  Service orders....."
        Label1.Caption = whseid_rst.AbsolutePosition & "/" & mtot_count
        Label2.Caption = "Start Time :" & mstart_time & " Current Time" & Now
        ser_stk_avl_routine.Text1.Refresh
        ser_stk_avl_routine.Show

        DoEvents
        Call Process_service_order(whseid_rst("PK_Num_Service_Ord_No"), whseid_rst("Whseid"))
        DoEvents
        whseid_rst.MoveNext
        DoEvents
        If mStop = True Then GoTo error_handle
    Loop
    whseid_rst.Close

    Call WriteToLogFileName("stk_service_order_time.txt", "Total Order=" & mtot_count & Chr(9) & "Start Time :" & mstart_time & Chr(9) & "End Time:" & Now & Chr(9) & "Total Min: " & DateDiff("N", mstart_time, Now))
        End

error_handle:
    If Not (whseid_rst Is Nothing) Then
        If whseid_rst.State <> 0 Then whseid_rst.Close
        Set whseid_rst = Nothing
    End If

    If Err Then Call WriteToCommonLog("initialize", Err.Number & ": " & Err.Description)

    End
End Sub

'Public Function get_manufacturer(mprod_code)
'    Dim rst3 As New ADODB.Recordset
'    str = "select coo from productmaster(NoLock) where productcode='" & mprod_code & "'"
'    Set rst3 = conn.Execute(str)
'    If rst3.EOF <> True Then
'        get_manufacturer = rst3("coo")
'    Else
'        get_manufacturer = " "
'    End If
'    rst3.Close
'    Set rst3 = Nothing
'End Function

Function pause(msec)
    Dim z As Double
    For z = 1 To msec
        Sleep (1000)
        DoEvents
        If mStop = True Then End
    Next
End Function

Private Sub sg_open_connection()
    On Error GoTo sg_conn_err
    Dim sConn As String

    If sg_conn.State <> 0 Then sg_conn.Close
    sg_conn.CommandTimeout = 800
    sg_conn.ConnectionTimeout = 800

    sConn = GetIniSetting(App.Path & "\Settings.ini", "india", "connstr")
    sg_conn.Open sConn

    Exit Sub

sg_conn_err:
    Call WriteToCommonLog("sg_open_connection", Err.Number & ": " & Err.Description)
        End
End Sub

'Public Sub WriteToCommonLog(ByVal sFunctionName As String, _
'                      ByVal sLogMsg As String)
'    Dim dtDate As Date
'    Dim sLogFileName As String
'
'    dtDate = Now()
'
'    sLogFileName = App.Path & "\stk_service_order_log.txt"
'    Open sLogFileName For Append As #88
'    Print #88, Format(Now, "YYYY-MM-DD HH:MM:SS") & vbTab & sFunctionName & vbTab & sLogMsg
'    Close #88
'End Sub

Public Sub WriteToLogFileName(ByVal fileName As String, ByVal sLogMsg As String)
    On Error Resume Next

    Dim sLogFileName$
    Dim fnum  As Integer
    fnum = -1

    sLogFileName = App.Path & "\" & fileName
    fnum = FreeFile

    If fnum > -1 Then
        Open sLogFileName For Append As #fnum
        Print #fnum, Format(Now, "YYYY-MM-DD HH:mm:SS") & vbTab & sLogMsg
        Close #fnum
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If Not conn Is Nothing Then
        If conn.State <> 0 Then
            conn.Close
            Set conn = Nothing
        End If
    End If
    If Not sg_conn Is Nothing Then
        If sg_conn.State <> 0 Then
            sg_conn.Close
            Set sg_conn = Nothing
        End If
    End If
End Sub

0 个答案:

没有答案