excelfile.frm

出版社图书出货管理系统,包括图书的出库,入库,结果输出

         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3480
      TabIndex        =   9
      Top             =   4440
      Width           =   975
   End
   Begin VB.Label Label7 
      Caption         =   "价  格:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3480
      TabIndex        =   8
      Top             =   3960
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "*.xls"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3240
      TabIndex        =   1
      Top             =   120
      Width           =   4575
   End
End
Attribute VB_Name = "excelfile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
 Dim workingfile As String  'DBF全文件名
  Dim filelast As String    '文件名
  Dim filefirst As String      '路径
  Dim tablen As String
  Dim fieldnum As Integer
  Dim recyes As Long
  Dim fbl As String
  Dim ex_rows As Long
  Dim ex_cols As Long
  
  CommonDialog1.Filter = "*.xls|*.xls"
  CommonDialog1.DefaultExt = "*.xls"
     
On Error GoTo aa
  recyes = 0
  CommonDialog1.ShowOpen
  
  workingfile = LTrim$(RTrim$(UCase$(CommonDialog1.filename)))
   Label1.Caption = workingfile
   Text1.Visible = False
  If workingfile = "" Then
    Exit Sub
    End If
  If UCase(Right(workingfile, 3)) <> "XLS" Then
     MsgBox "不是excel文件!"
     Exit Sub
     End If
  
 If Not Filexists(workingfile) Then
    MsgBox "文件不存在,请重新输入。"
    Exit Sub
    End If


     Set ex = CreateObject("Excel.Application")
     Set exwbook = ex.Workbooks.Open(workingfile)
     Set Sheet = exwbook.Worksheets(1)
     Set sv_rng = Sheet.UsedRange
     ex_rows = sv_rng.Rows.Count     '行数
     ex_cols = sv_rng.Columns.Count    '列数
 
 MSFlexGrid1.Rows = 10
 MSFlexGrid1.Cols = ex_cols
 Me.Caption = "EXCEL中共有数据" & ex_rows - 1 & "条，将转入" & worktok
 For i = 0 To ex_cols - 1
   MSFlexGrid1.TextMatrix(0, i) = Sheet.Cells(0 + 1, i + 1)
 Next i
 
 For i = 0 To 7
    For j = 0 To ex_cols - 1
     
    MSFlexGrid1.TextMatrix(i + 1, j) = Sheet.Cells(i + 1 + 1, j + 1)
    
    Next j
    
 Next i

  Combo1.Clear
 Combo2.Clear
 Combo3.Clear
 Combo4.Clear
 Combo5.Clear
 Combo6.Clear
  Combo7.Clear
  Combo9.Clear
  Combo10.Clear
  Combo11.Clear
  Combo12.Clear
 Combo1.AddItem "无字段对应"
 Combo2.AddItem "无字段对应"
 Combo3.AddItem "无字段对应"
 Combo4.AddItem "无字段对应"
 Combo5.AddItem "无字段对应"
 Combo6.AddItem "无字段对应"
  Combo7.AddItem "无字段对应"
  Combo9.AddItem "无字段对应"
   Combo10.AddItem "无字段对应"
   Combo11.AddItem "无字段对应"
   Combo12.AddItem "无字段对应"
    Combo13.AddItem "无字段对应"
  Combo1.Text = "无字段对应"
   Combo2.Text = "无字段对应"
    Combo3.Text = "无字段对应"
     Combo4.Text = "无字段对应"
      Combo5.Text = "无字段对应"
      Combo6.Text = "无字段对应"
       Combo7.Text = "无字段对应"
       Combo9.Text = "无字段对应"
       Combo10.Text = "无字段对应"
       Combo11.Text = "无字段对应"
       Combo12.Text = "无字段对应"
    Combo13.Text = "无字段对应"
 For i = 1 To ex_cols
  Combo1.AddItem Sheet.Cells(1, i)
  Combo2.AddItem Sheet.Cells(1, i)
  Combo3.AddItem Sheet.Cells(1, i)
  Combo4.AddItem Sheet.Cells(1, i)
  Combo5.AddItem Sheet.Cells(1, i)
  Combo6.AddItem Sheet.Cells(1, i)
  Combo7.AddItem Sheet.Cells(1, i)
    Combo9.AddItem Sheet.Cells(1, i)
    Combo10.AddItem Sheet.Cells(1, i)
     Combo11.AddItem Sheet.Cells(1, i)
      Combo12.AddItem Sheet.Cells(1, i)
      Combo13.AddItem Sheet.Cells(1, i)
 Next i
 exwbook.Close
 Command2.Enabled = True

 Exit Sub
aa:
 MsgBox Err.Description & "excel 文件打开转入有错误."
End Sub

Private Sub Command2_Click()
Dim recnum As Long
  Dim isbnstring As String
  Dim isbn As String
  Dim sm As String
  Dim author As String
  Dim cbs As String
  Dim cbn As String
  Dim recordno As Long
  Dim jg As String
  Dim context As String
  Dim provide As String
  Dim recyes As Long
  Dim ex_rows As Long
  Dim ex_cols As Long
  Dim isbnspace As String
 '读取EXCEL文件中的数据，及行数，列数
 
     Set ex = CreateObject("Excel.Application")
     Set exwbook = ex.Workbooks.Open(Label1.Caption)
     Set Sheet = exwbook.Worksheets(1)
     Set sv_rng = Sheet.UsedRange
    ex_rows = sv_rng.Rows.Count     '从1-Excel的最末行的名称
    ex_cols = sv_rng.Columns.Count    '当Excel表中有596行时，返回595行
 
 On Error Resume Next
  isbnstring = ""
  recyes = 0
  recordno = 0
  recnum = 0
  isbnspace = ""
  If Combo2.Text = "无字段对应" Then
    MsgBox "您还没有选字段书名"
    Exit Sub
    End If
 
 For i = 2 To ex_rows  'EXCEL从第一行开始读取
 
  isbn = ""
  If Combo1.Text <> "无字段对应" Then
   j = Combo1.ListIndex
   isbn = Sheet.Cells(i, j)
   If Check1.Value = 1 Then
   
   isbn = RTrim(LTrim(isbndel(isbn)))
   isbn = RTrim(LTrim(Left(isbndelt(isbn), 10)))
   If (Len(isbn) <> 10) And (worktok = "预采库") Then
    isbnspace = isbnspace & "," & Str(i) & "(" & isbn & ")"  '需报告出来
    If Option1.Value <> True Then
       GoTo aa1
    End If
   End If
    If (Left(isbn, 1) <> "7") And (worktok = "预采库") Then
      isbnspace = isbnspace & "/" & isbn '错误ISBN报告
      If Option1.Value <> True Then
        GoTo aa1
      End If
     End If
   End If
  End If
  
  sm = ""
  If Combo2.Text <> "无字段对应" Then
  j = Combo2.ListIndex
  sm = Sheet.Cells(i, j)
  End If
  
  author = ""
  If Combo3.Text <> "无字段对应" Then
  j = Combo3.ListIndex
  author = Sheet.Cells(i, j)
  End If
  
  cbs = ""
  If Combo4.Text <> "无字段对应" Then
  j = Combo4.ListIndex
  cbs = Sheet.Cells(i, j)
  End If
  
  cbn = ""
  If Combo5.Text <> "无字段对应" Then
  j = Combo5.ListIndex
  cbn = Sheet.Cells(i, j)
  End If
  
  jg = "0"
  If Combo6.Text <> "无字段对应" Then
  j = Combo6.ListIndex
  jg = Sheet.Cells(i, j)
  jg = RTrim(LTrim(pricedel(jg)))
  If Len(jg) = 0 Then jg = "0"
  If jg = Null Then jg = "0"
  End If
  
  fbl = "0"
  If Combo7.Text <> "无字段对应" Then
  j = Combo7.ListIndex
  fbl = Sheet.Cells(i, j)
  dgs = fbl
  End If
  
  context = ""
   If Combo9.Text <> "无字段对应" Then
   j = Combo9.ListIndex
  context = Sheet.Cells(i, j)
  End If
  
  provide = ""
   If Combo10.Text <> "无字段对应" Then
   j = Combo10.ListIndex
  provide = Sheet.Cells(i, j)
  End If
  
   bjh = ""
   If Combo12.Text <> "无字段对应" Then
   j = Combo12.ListIndex
  bjh = Sheet.Cells(i, j)
  End If
  
   lassh = ""
   If Combo11.Text <> "无字段对应" Then
   j = Combo11.ListIndex
   lassh = Sheet.Cells(i, j)
  End If
  
If worktok = "预采库" Then
  If Option1.Value = True Then
    Data2.Recordset.FindFirst ("isbn='abcdefghijklmnopqrstuvwd'")

  End If
  If Option2.Value = True Then
   Data2.Recordset.FindFirst ("isbn='" & isbn & "'")

  End If
  If Option3.Value = True Then
   Data2.Recordset.FindFirst ("isbn='" & isbn & "' and bookname='" & sm & "'")

  End If
  If Option4.Value = True Then
     Data2.Recordset.FindFirst ("isbn='" & isbn & "' and bookname='" & sm & "' and jg='" & jg & "'")
  End If
  
  If Data2.Recordset.NoMatch Then
     Data2.Recordset.AddNew
     Data2.Recordset("bookname") = LTrim$(RTrim$(Left$(sm, 50)))
     Data2.Recordset("author") = LTrim$(RTrim$(Left$(author, 25)))
     Data2.Recordset("isbn") = LTrim$(RTrim$(Left$(isbn, 25)))
     Data2.Recordset("bms") = LTrim$(RTrim$(Left$(cbs, 25)))
     Data2.Recordset("bmn") = LTrim$(RTrim$(Left$(cbn, 10)))
     Data2.Recordset("jg") = LTrim$(RTrim$(Left$(jg, 15)))
     Data2.Recordset("fbl") = Val(LTrim$(RTrim$(Left$(fbl, 5))))
     Data2.Recordset("dgs") = 0
     Data2.Recordset("context") = context
     Data2.Recordset("provide") = LTrim$(RTrim$(Left$(provide, 25)))
     Data2.Recordset("bjh") = LTrim$(RTrim$(Left$(bjh, 20)))
     Data2.Recordset("class") = LTrim$(RTrim$(Left$(lassh, 20)))
     Data2.Recordset("modidate") = Now()
     Data2.Recordset.Update
     recyes = recyes + 1
    
   Else
        isbnstring = isbnstring & "," & isbn
        recordno = recordno + 1
        GoTo aa1
     
  End If
Else
     Data2.Recordset.AddNew
     Data2.Recordset("bookname") = LTrim$(RTrim$(Left$(sm, 50)))
     Data2.Recordset("author") = LTrim$(RTrim$(Left$(author, 25)))
     Data2.Recordset("isbn") = LTrim$(RTrim$(Left$(isbn, 10)))
     Data2.Recordset("bms") = LTrim$(RTrim$(Left$(cbs, 25)))
     Data2.Recordset("bmn") = LTrim$(RTrim$(Left$(cbn, 10)))
     Data2.Recordset("jg") = LTrim$(RTrim$(Left$(jg, 15)))
     Data2.Recordset("fbl") = LTrim$(RTrim$(Left$(fbl, 5)))
      Data2.Recordset("dgs") = Val(LTrim$(RTrim$(Left$(fbl, 5))))
     Data2.Recordset("context") = context
     Data2.Recordset("provide") = LTrim$(RTrim$(Left$(provide, 25)))
     Data2.Recordset("bjh") = LTrim$(RTrim$(Left$(bjh, 20)))
     Data2.Recordset("class") = LTrim$(RTrim$(Left$(Class, 20)))
     Data2.Recordset("modidate") = Now()
     Data2.Recordset.Update
     recyes = recyes + 1
    

End If

 
aa1:
  Me.Caption = "正在进行数据转入，请稍等！" & Str(i)
 Next i 'EXCEE一行一行读取
 exwbook.Close
 Me.Caption = "excel 数据转入"
 MsgBox "数据处理完成!"
 Text1.Visible = True
 If worktok = "预采库" Then
 Text1.Text = "数据处理完成,有数据条数：" & ex_rows - 1 & "；共转入" & Str(recyes) & "条数据到" & worktok & "，有" & recordno & "条重复记录未转入，其ISBN为：" & isbnstring & "错误数据未转入：" & isbnspace
 Else
  Text1.Text = "数据处理完成,有数据条数：" & ex_rows - 1 & "；共转入" & Str(recyes) & "条数据到" & worktok & "，其它数据为ISBN号为空未转入！"
 End If
 Command2.Enabled = False
 Exit Sub
aa:
 MsgBox Err.Description
End Sub

Private Sub Command3_Click()
Unload excelfile
End Sub


Private Sub Form_Load()
 Command2.Enabled = False
 Combo10.Visible = False
 Combo13.Visible = False
   Data2.RecordSource = "预采数据"
    Option1.Visible = True
     Option2.Visible = True
     Option3.Visible = True
     Option4.Visible = True
  Text1.Visible = False
  Data2.Refresh
End Sub