frmdownorder.frm

用VB6.0编写的关于车辆运输调度的系统

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{B02F3647-766B-11CE-AF28-C3A2FBE76A13}#2.5#0"; "SS32X25.OCX"
Begin VB.Form frmDownOrder 
   Caption         =   "DownLoad Order"
   ClientHeight    =   7335
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9420
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   9
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "frmDownOrder"
   MDIChild        =   -1  'True
   ScaleHeight     =   7335
   ScaleWidth      =   9420
   WindowState     =   2  'Maximized
   Begin MSComctlLib.ProgressBar PrBar2 
      Height          =   195
      Left            =   2640
      TabIndex        =   5
      Top             =   240
      Width           =   4095
      _ExtentX        =   7223
      _ExtentY        =   344
      _Version        =   393216
      Appearance      =   1
   End
   Begin VB.CommandButton CmdCancel 
      Caption         =   "Cancel"
      Height          =   375
      Left            =   7200
      TabIndex        =   3
      Top             =   6720
      Width           =   1095
   End
   Begin VB.CommandButton CmdImport 
      Caption         =   "Import"
      Height          =   375
      Left            =   5880
      TabIndex        =   2
      Top             =   6720
      Width           =   1095
   End
   Begin VB.CommandButton CmdView 
      Caption         =   "View"
      Height          =   375
      Left            =   4560
      TabIndex        =   1
      Top             =   6720
      Width           =   1215
   End
   Begin FPSpread.vaSpread vasOrderD 
      Height          =   5655
      Left            =   240
      TabIndex        =   0
      Top             =   720
      Width           =   8775
      _Version        =   131077
      _ExtentX        =   15478
      _ExtentY        =   9975
      _StockProps     =   64
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      SpreadDesigner  =   "frmDownOrder.frx":0000
   End
   Begin VB.Label Label2 
      Caption         =   "Sales Order Info"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   240
      TabIndex        =   4
      Top             =   240
      Width           =   2055
   End
End
Attribute VB_Name = "frmDownOrder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private a() As String
Private b() As String

'Private Enum enuOrderH
'    salotyp = 1
'    salonum
'    salocre
'    cmpcode
'    Entcode
'    soddate
'    doddate
'    CusCode
'
'    MaxCols = CusCode
'End Enum


Private Enum enuOrderD
    cmpcode = 1
    Entcode
    cuscode
    picknum
    salotype
    salonum
    salolin
    Itecode
    Itedesc
    sugoqty
    Meaunit
     
    MaxCols = Meaunit
End Enum


Private Sub cmdview_Click()
    Call Orderh_down
    CmdView.Enabled = False
    CmdImport.Enabled = True

End Sub

Private Sub cmdCancel_Click()
       vasOrderD.MaxRows = 0
       CmdView.Enabled = True
       PrBar2.Visible = False
End Sub

Private Sub cmdimport_click()

    If OrderImport = True Then
        CmdView.Enabled = True
        CmdImport.Enabled = False
        MsgBox "Import Data is success!", vbOKOnly, "Success"
        Unload Me
    End If

End Sub

Private Sub Form_Load()
      
      Call initvas
      
      Call IniCompCode
      
      lockspread vasOrderD, True
      
      CmdImport.Enabled = False
      PrBar2.Visible = False
End Sub

Private Sub IniCompCode()
Dim sSQL As String
Dim rstcomp As Recordset
Dim iCount As Long

    sSQL = "select * from appcon"
    Set rstcomp = Acs_cnt.Execute(sSQL)
    
    iCount = 1
    With rstcomp
    Do While Not .EOF
        ReDim Preserve a(iCount) As String
        ReDim Preserve b(iCount) As String
        a(iCount) = rstcomp!ordcode
        b(iCount) = rstcomp!ordname
        iCount = iCount + 1
        .MoveNext
    Loop
    End With
    
    rstcomp.Close
    Set rstcomp = Nothing
    
End Sub
Private Function OrderImport() As Boolean
On Error GoTo err
Dim sSQL As String, sSQL1 As String, sSQL2 As String
Dim iRow As Long, iCount As Long
Dim lsalonum As Long, lsalolin As Long, litecode As Long, lsugoqty As Long, lcuscode As Long
Dim scmpcode As String, sentcode As String, sitedesc As String, smeaunit As String
Dim lsalolnc As Long, lpicknum As Long
Dim ssalotype As String, typecode As String
Dim tmpiteCode As Long, tmpsugoqty As Long, tmpcuscode As Long
Dim rstOrderSO As Recordset, rstOrderDO As Recordset, rstOrderTO As Recordset, rstTemp As Recordset

OrderImport = False

iRow = 0
lsalolnc = ChangeDate(Date)

    sSQL1 = "delete from orderd where salotyp in ('SO','DO') "
    
    sSQL2 = "delete from orderd where salolnc <lsalolnc and sugonum > 0"
    
    Acs_cnt.BeginTrans
    Acs_cnt.Execute (sSQL1)
    Acs_cnt.Execute (sSQL1)
    Acs_cnt.CommitTrans
    
With vasOrderD
For iRow = 1 To .DataRowCnt
    .Row = iRow
    scmpcode = GetValue(vasOrderD, .Row, enuOrderD.cmpcode)
    sentcode = GetValue(vasOrderD, .Row, enuOrderD.Entcode)
    litecode = GetValue(vasOrderD, .Row, enuOrderD.Itecode)
    sitedesc = GetValue(vasOrderD, .Row, enuOrderD.Itedesc)
    lsalonum = GetValue(vasOrderD, .Row, enuOrderD.salonum)
    lsalolin = GetValue(vasOrderD, .Row, enuOrderD.salolin)
    lsugoqty = GetValue(vasOrderD, .Row, enuOrderD.sugoqty)
    smeaunit = GetValue(vasOrderD, .Row, enuOrderD.Meaunit)
    typecode = GetValue(vasOrderD, .Row, enuOrderD.salotype)
    lpicknum = GetValue(vasOrderD, .Row, enuOrderD.picknum)
    
    For iCount = 1 To UBound(a)
        If typecode = a(iCount) Then
            ssalotype = b(iCount)
            Exit For
        End If
    Next iCount
    
    lcuscode = GetValue(vasOrderD, .Row, enuOrderD.cuscode)
    lpicknum = GetValue(vasOrderD, .Row, enuOrderD.picknum)
    
    sSQL = "select * from orderd where salotyp='TO' and itecode=" & litecode & " and salonum=" & lsalonum & " and salolin = " & lsalolin & " and picknum=" & lpicknum & " "
    Set rstTemp = Acs_cnt.Execute(sSQL)
    If rstTemp.EOF Then
        sSQL = "insert into orderd(cmpcode,entcode,sugonum,picknum,sugolin,salotyp,cuscode,salonum,salolin,salolnc,itecode,itedesc,sugoqty,meaunit)" & _
               " values('" & scmpcode & "','" & sentcode & "',0," & lpicknum & "," & lsalolin & ",'" & ssalotype & "'," & lcuscode & "," & lsalonum & "," & lsalolin & "," & lsalolnc & "," & litecode & ",'" & sitedesc & "'," & lsugoqty & ",'" & smeaunit & "') "
        
        Acs_cnt.BeginTrans
        Acs_cnt.Execute (sSQL)
        Acs_cnt.CommitTrans
    Else
        sSQL1 = "insert into orderdback select * from orderd"
        sSQL2 = "update orderd set salotyp='" & ssalotype & "',sugoqty=" & lsugoqty & ",salolnc='" & lsalolnc & "' where itecode=" & litecode & " and salotyp='TO' and salonum=" & lsalonum & " and salolin = " & lsalolin & " and picknum=" & lpicknum & ""
        
        Acs_cnt.BeginTrans
        Acs_cnt.Execute (sSQL1)
        Acs_cnt.Execute (sSQL2)
        Acs_cnt.CommitTrans
    End If
    
Next iRow
End With

'Update SO number
sSQL = "select cuscode,itecode, sum(sugoqty) as qty from orderd where salotyp='SO' group by cuscode,itecode"
Set rstOrderSO = Acs_cnt.Execute(sSQL)

With rstOrderSO
Do While Not .EOF
    tmpcuscode = rstOrderSO!cuscode
    tmpiteCode = rstOrderSO!Itecode
    tmpsugoqty = rstOrderSO!Qty
    sSQL = "update appcut set orderso=" & tmpsugoqty & " where cuscode=" & tmpcuscode & " and procode=" & tmpiteCode & ""
    
    Acs_cnt.BeginTrans
    Acs_cnt.Execute (sSQL)
    Acs_cnt.CommitTrans
    
    .MoveNext
Loop
End With

'Update DO number
sSQL = "select cuscode,itecode, sum(sugoqty) as qty from orderd where salotyp='DO' group by cuscode,itecode"
Set rstOrderDO = Acs_cnt.Execute(sSQL)

With rstOrderDO
Do While Not .EOF
    tmpcuscode = rstOrderDO!cuscode
    tmpiteCode = rstOrderDO!Itecode
    tmpsugoqty = rstOrderDO!Qty
    sSQL = "update appcut set orderdo=" & tmpsugoqty & " where cuscode=" & tmpcuscode & " and procode=" & tmpiteCode & ""
    
    Acs_cnt.BeginTrans
    Acs_cnt.Execute (sSQL)
    Acs_cnt.CommitTrans
    
    .MoveNext
Loop
End With


'Update TO number
sSQL = "select cuscode,itecode, sum(sugoqty) as qty from orderd where salotyp='TO' group by cuscode,itecode"
Set rstOrderTO = Acs_cnt.Execute(sSQL)

With rstOrderTO
Do While Not .EOF
    tmpcuscode = rstOrderTO!cuscode
    tmpiteCode = rstOrderTO!Itecode
    tmpsugoqty = rstOrderTO!Qty
    sSQL = "update appcut set orderto=" & tmpsugoqty & " where cuscode=" & tmpcuscode & " and procode=" & tmpiteCode & ""
    
    Acs_cnt.BeginTrans
    Acs_cnt.Execute (sSQL)
    Acs_cnt.CommitTrans
    
    .MoveNext
Loop
End With

rstOrderSO.Close
rstOrderDO.Close
rstOrderTO.Close

Set rstOrderSO = Nothing
Set rstOrderDO = Nothing
Set rstOrderTO = Nothing

OrderImport = True

Exit Function

err:
    MsgBox err.Description, vbOKOnly, "Error"
End Function

Private Sub initvas()
   
   vasOrderD.MaxRows = 0
   vasOrderD.MaxCols = enuOrderD.MaxCols
   
   SetColHead vasOrderD, enuOrderD.cmpcode, "Company Code", 10
   SetColHead vasOrderD, enuOrderD.Entcode, "Entity Code ", 12
   SetColHead vasOrderD, enuOrderD.cuscode, "Customer Code", 12
   SetColHead vasOrderD, enuOrderD.salotype, "Sales Order Type", 14
   SetColHead vasOrderD, enuOrderD.salonum, "Sales Order Number", 8
   SetColHead vasOrderD, enuOrderD.salolin, "Sales Order Line Number", 14
   SetColHead vasOrderD, enuOrderD.Itecode, "Item Code", 12
   SetColHead vasOrderD, enuOrderD.Itedesc, "Item Desc", 14
   SetColHead vasOrderD, enuOrderD.sugoqty, "Order Quantity", 12
   SetColHead vasOrderD, enuOrderD.picknum, "Pick Number", 12
   SetColHead vasOrderD, enuOrderD.Meaunit, "Unit of Measurement", 12
   
   
End Sub

Private Sub Orderh_down()
Dim iCount As Long
Dim litecode As Long
Dim rstOrderd As New Recordset

   DBFC ("upload")

   
   PrBar2.Visible = True
   Set rstOrderd = DBF_cnt.Execute("select sdkcoo,sdlttr,sddoco,sddcto,sdtrdj,sditm,sduorg,sdlnid,sduom,sddsc1,sdpsn,sdan8 from Spb4211 order by sddoco,sdlnid")
   PrBar2.max = rstOrderd.RecordCount
    
      
   iCount = 0
   vasOrderD.MaxRows = 0
   With vasOrderD
   Do While Not rstOrderd.EOF
        PrBar2.Value = iCount
        litecode = rstOrderd!sdItm
        If ExistItem(litecode) = True Then
            vasOrderD.MaxRows = vasOrderD.MaxRows + 1
            .Row = vasOrderD.MaxRows
            SetValue vasOrderD, .Row, enuOrderD.Entcode, rstOrderd!sdkcoo
            SetValue vasOrderD, .Row, enuOrderD.cmpcode, rstOrderd!sdkcoo
            SetValue vasOrderD, .Row, enuOrderD.salotype, rstOrderd!sdlttr
            SetValue vasOrderD, .Row, enuOrderD.salonum, rstOrderd!sddoco
            SetValue vasOrderD, .Row, enuOrderD.Meaunit, rstOrderd!sduom
            SetValue vasOrderD, .Row, enuOrderD.sugoqty, rstOrderd!sduorg
            SetValue vasOrderD, .Row, enuOrderD.salolin, rstOrderd!sdlnid
            SetValue vasOrderD, .Row, enuOrderD.Itecode, rstOrderd!sdItm
            SetValue vasOrderD, .Row, enuOrderD.Itedesc, rstOrderd!sddsc1
            SetValue vasOrderD, .Row, enuOrderD.picknum, rstOrderd!sdpsn
            SetValue vasOrderD, .Row, enuOrderD.cuscode, rstOrderd!sdan8
        End If
        rstOrderd.MoveNext
        iCount = iCount + 1
   Loop
   End With
   
   PrBar2.Value = rstOrderd.RecordCount
   
   rstOrderd.Close
   Set rstOrderd = Nothing
   
   DBF_cnt.Close
   
End Sub

Private Function ExistItem(ByVal litecode As Long) As Boolean
Dim sSQL As String
Dim rstTemp As Recordset

    ExistItem = False
    sSQL = "select * from appite where astatus='Y' and itecode=" & litecode
    Set rstTemp = Acs_cnt.Execute(sSQL)
    If rstTemp.RecordCount > 0 Then
        ExistItem = True
    Else
        ExistItem = False
    End If
    
    rstTemp.Close
    Set rstTemp = Nothing
    
End Function