modulemain.bas

仓库扫描管理系统

        End If
    Next
End Sub

Public Function checkbarcodesRepeated(flxGrd As MSFlexGrid) As String
    Dim i, j, endRow As Integer
    Dim strMsg, strBarcode As String
'   给空行记数
'    Dim iCount, jCount As Integer
'    iCount = 0
    strMsg = ""
'   第一层循环，一个一个与其它所有的比较
    For i = flxGrd.FixedRows To flxGrd.rows - 1
        strBarcode = flxGrd.TextMatrix(i, 1)
'        将第i条条形码循环与其它比较
'        将第i条条形码循环与邻近的3行比较
'        For j = i + 1 To flxGrd.rows - 1
        endRow = i + 3
        If endRow >= flxGrd.rows Then
            endRow = flxGrd.rows - 1
        End If
        For j = i + 1 To endRow
            ' 设置第j行为当前行
            flxGrd.row = j
            flxGrd.col = flxGrd.FixedCols
            '   如果当前行已经为红色则不用比较了
            If j <> i Then
            '   空值不用比较，当有重复的条形码时红色显示
                If strBarcode <> "" And strBarcode = flxGrd.TextMatrix(j, 1) Then
                    strMsg = strMsg + vbCrLf + "序号为 " + flxGrd.TextMatrix(j, 0) + " 的条形码与序号为 " + flxGrd.TextMatrix(i, 0) + " 的重复！"
                    '  红色警示显示
                    flxGrd.CellBackColor = vbRed
                End If
            End If
        Next
    Next
    checkbarcodesRepeated = strMsg
End Function
'   将文本文件中的数据导入到数据库中：文本文件中每行对应一条记录，每行两个值(以逗号分隔开)；
'   第一个值表示为单据序号，第二个值表示扫描的条码号。dataType表示数据类型：RK-表示入库单数据；CK－表示出库单数据
Public Function importDataFromFile(filePath As String, dataType As String) As Boolean
    importDataFromFile = False
    Dim mainTableName As String
    Dim dtlTableName As String
    mainTableName = ""
    If UCase(dataType) = "RK" Then
        mainTableName = "hpos_StockIncomeBill_Master"
        dtlTableName = "hpos_StockIncomeBill_Dtl"
    End If
    If UCase(dataType) = "CK" Then
        mainTableName = "hpos_StockOutBill_Master"
        dtlTableName = "hpos_StockOutBill_Dtl"
    End If
    
'   定义分隔符
    Dim separator As String
'   定义每行分隔符所在的位置
    Dim pos, row As Integer
    separator = ","
    Dim fs As New FileSystemObject
    Dim txtStream As TextStream
    Set txtStream = fs.OpenTextFile(filePath)
    Dim strLine, sql As String
    Dim billNo As String
    Dim billDate As Date
    billDate = Now()
'   获取单据ID
    Dim billId As String
'    billId = CStr(getNextPK(mainTableName, "billId"))
'    billId = CStr(getNextPK(mainTableName, "billId") - 1)
    Dim lngBillId As Long
    lngBillId = getNextPK(mainTableName, "billId") - 1
    
    billNo = getNextBillNo(mainTableName, "billNo")
    Dim PrefixBillNo As String
    Dim billNoSequence As Long
    PrefixBillNo = Mid(billNo, 1, 7)
    billNoSequence = CLng(Mid(billNo, 8, 4)) - 1
    
    
    '   定义以逗号分隔开的数据变量
    Dim billSequence, billSequenceArray, lastBillSequence, barcode As String
    Dim dtlId As String
    sql = ""
    row = 0
    wrks.BeginTrans
    Do While txtStream.AtEndOfLine <> True
        row = row + 1
        strLine = txtStream.ReadLine
        pos = InStr(1, strLine, separator, vbTextCompare)
        billSequence = Trim(Mid(strLine, 1, pos - 1))
        barcode = Trim(Mid(strLine, pos + 1, Len(strLine)))
        billId = CStr(lngBillId + CLng(Mid(strLine, 1, 2)))
        billNo = PrefixBillNo + String(4 - Len(CStr(billNoSequence + CLng(Mid(strLine, 1, 2)))), "0") + CStr(billNoSequence + CLng(Mid(strLine, 1, 2)))
'       如果找不到
        If InStr(1, billSequenceArray, billSequence, vbTextCompare) = 0 Then
            billSequenceArray = billSequenceArray + billSequence
'          往主表中插入数据   注意单条SQL语句执行
            sql = " insert into " + mainTableName + "(billId, store, billDate,  billNo, handler, billType, rsvFld1, rsvFld2, rsvFld3)" _
                    & " values('" + billId + "', '" + g_store + "','" + CStr(Now) + "',  '" + billNo + "', '" + g_userName + "',0 , '', '', '" + billSequence + "');"
            g_db.Execute sql
        End If
'      往从表中插入数据   注意单条SQL语句执行
        sql = getInsertSQL(barcode, dtlTableName, billId, row)
        If Trim(sql) <> "" Then
            g_db.Execute sql
        Else
            wrks.Rollback
            MsgBox "文件格式不正确，请先检查盘点机数据文件中的物料编码是否已经登记！" + vbCrLf + vbCrLf + "正确的文件格式为:客户号和条码号组成，" + vbCrLf + vbCrLf + "二者之间以逗号分隔开。", vbInformation, "提示"
            Exit Function
        End If
        
    Loop
'    g_db.Execute sql
    wrks.CommitTrans
    txtStream.Close
    If backUpFile(filePath) Then
        importDataFromFile = True
    End If
End Function
'   构造SQL语句
Public Function getInsertSQL(barcode As String, dtlTableName As String, billId As String, row As Integer) As String
    Dim rs As Recordset
    Dim productCode, sql, dtlId As String
    Dim sequenceNo As String
    sql = ""
    Set rs = g_db.OpenRecordset("SELECT MAX(CLNG(rsvFld1)) as sequenceNo from " & dtlTableName & " where billId='" + billId + "'")
    If IsNull(rs.Fields("sequenceNo")) Then
      sequenceNo = 1
    Else
        sequenceNo = CLng(rs.Fields("sequenceNo")) + 1
    End If
    dtlId = billId & "_" & sequenceNo
    productCode = Mid(barcode, g_barcode_product_start, g_barcode_weight_start - g_barcode_product_start - g_barcode_sequenceno_len)
    Dim netWeight, qty As Double
    qty = Format(Val(Mid(barcode, g_barcode_weight_start, g_barcode_length - g_barcode_weight_start)) / g_barcode_weight_base, g_barcode_weight_scale)
    netWeight = Val(Mid(barcode, g_barcode_weight_start, g_barcode_length - g_barcode_weight_start)) / g_barcode_weight_base
    Set rs = g_db.OpenRecordset("select * from hpos_products where (hpos_products.productCode ='" + productCode + "')")
    If rs.RecordCount > 0 Then
        sql = sql + " insert into " + dtlTableName + "(dtlId, billId, barcode, productId, qty, price, pieceQty, axesWeight, comment, rsvFld1, rsvFld2, rsvFld3)" _
                & " values(  '" + dtlId + "', '" + billId + "', '" + barcode + "', " + CStr(rs.Fields("productId")) + ", " + CStr(qty) + ", 0.0, 1.0, 0.0, '', '" + sequenceNo + "', '', ''); "
    End If
    getInsertSQL = sql
End Function
'   备份文件，先更名并copy到备份目录，然后删除
Public Function backUpFile(filePath As String) As Boolean
    backUpFile = False
    Dim strBackupFolder, destFilePath As String
    strBackupFolder = Mid(filePath, 1, InStrRev(filePath, "\")) + "backup"
    If Dir(strBackupFolder, vbDirectory) = "" Then
        MkDir strBackupFolder
    End If
    destFilePath = strBackupFolder + "\" + CStr(Format(Now, "YYYYMMDDHHMMSS")) + Mid(filePath, InStrRev(filePath, "\") + 1)
    FileCopy filePath, destFilePath
    Kill filePath
'    fs.DeleteFile filePath
    backUpFile = True
End Function
'   从文本文件中读取数据加载到MSFlexGrid中
'  http://community.csdn.net/Expert/topic/4944/4944889.xml?temp=.8284571
'  http://topic.csdn.net/t/20050331/07/3896154.html
'  http://topic.csdn.net/t/20050218/18/3790640.html
'  在帮助文档 VBENLR98.CHM 中查找 TextStream
Public Sub loadDataFromTextFileToFlexGrd(filePath As String, flexGrd As MSFlexGrid)
    Dim fldValues
    Dim i As Integer
'   定义要映射的列数
    Dim colCount As Integer
    colCount = 2
    Dim colArray As Variant
'   定义要映射的列号
    colArray = Array(1, 10, 11, 12)
'     y = Array("序号", "条  码  号", "物料名称", "型号||规格", " 标 准", "单位", "净重", "价格", "金额", "总皮重", "件/箱", "毛重", "工号", "productId")
'   定义分隔符
    Dim separator As String
    separator = ","
'   定义起始行
    Dim startRow, currentRow As Integer
    startRow = flexGrd.rows - 1
    currentRow = startRow
    '   定义起始列
    Dim startCol, nextStartCol As Long
    Dim fs As New FileSystemObject
    Dim txtStream As TextStream
    
    Set txtStream = fs.OpenTextFile(filePath)
    If txtStream Is Nothing Then
        MsgBox "对不起，文件(" + filePath + ")不存在！", vbInformation, "提示"
        Exit Sub
    End If
    Dim strLine As String
    '   定义以逗号分隔开的字符串
    Dim strFldValue As String
    
    Do While txtStream.AtEndOfLine <> True
        flexGrd.TextMatrix(currentRow, 0) = currentRow
        strLine = txtStream.ReadLine
    '   替换每行中的HTML空格 &nbsp;
        strLine = Replace(strLine, "&nbsp;", "")
        i = 0   '重新从MSFlexGrid的第0列开始
        startCol = 1
        nextStartCol = startCol
        '  根据逗号查找每一列的值并且填入到表格中
        While Not (InStr(startCol, strLine, ",", vbTextCompare) = 0 Or IsNull(InStr(startCol, strLine, ",", vbTextCompare)))
            nextStartCol = InStr(startCol, strLine, ",", vbTextCompare) + 1
            strFldValue = Mid(strLine, startCol, nextStartCol - startCol - 1)
            startCol = nextStartCol
            flexGrd.TextMatrix(currentRow, colArray(i)) = strFldValue
            '   当给第一列(条形码)赋值时，将物料编号、规格型号以及净重等填入表格中
            If colArray(i) = 1 Then
                fillGridDataFromBarcode flexGrd, strFldValue
            End If
            i = i + 1
        Wend
    '   最后一列的值找不到逗号了，但是仍然需要填充到表格中
        flexGrd.TextMatrix(currentRow, colArray(i)) = Mid(strLine, startCol)
    '   表格增加一行
        flexGrd.rows = flexGrd.rows + 1
        currentRow = currentRow + 1
    Loop
End Sub

' 从条形码中获取物料及其重量信息填充界面表格
Public Sub fillGridDataFromBarcode(flexGrd As MSFlexGrid, strBarcode As String)
    Dim productCode As String
    productCode = Mid(strBarcode, g_barcode_product_start, g_barcode_weight_start - g_barcode_product_start - g_barcode_sequenceno_len)
    Dim netWeight As Double
    netWeight = Val(Mid(strBarcode, g_barcode_weight_start, g_barcode_length - g_barcode_weight_start)) / g_barcode_weight_base

    Dim rsProduct As Recordset
    ' 产品编号取条形码中的3到7位
    Set rsProduct = g_db.OpenRecordset("select * from hpos_products where (hpos_products.productCode ='" + productCode + "')")
     With rsProduct
         If rsProduct.RecordCount > 0 Then
              If rsProduct.Fields("productCode") <> "" Then
                   '赋值给mf1表格
                    If IsNumeric(Mid(strBarcode, g_barcode_weight_start, g_barcode_length - g_barcode_weight_start)) Then
                        flexGrd.TextMatrix(flexGrd.row, 6) = Format(Val(Mid(strBarcode, g_barcode_weight_start, g_barcode_length - g_barcode_weight_start)) / g_barcode_weight_base, g_barcode_weight_scale)
                    End If
                    If Not IsNull(.Fields("productName")) Then
                      flexGrd.TextMatrix(flexGrd.row, 2) = .Fields("productName")
                    End If
                    If Not IsNull(.Fields("productModel")) Then
                      flexGrd.TextMatrix(flexGrd.row, 3) = .Fields("productModel")
                    End If
                    If Not IsNull(.Fields("productSpecs")) Then
                      flexGrd.TextMatrix(flexGrd.row, 3) = flexGrd.TextMatrix(flexGrd.row, 3) + " || " + .Fields("productSpecs")
                    End If
                    If Not IsNull(.Fields("productStd")) Then
                      flexGrd.TextMatrix(flexGrd.row, 4) = .Fields("productStd")
                    End If
                    If Not IsNull(.Fields("productUnit")) Then
                      flexGrd.TextMatrix(flexGrd.row, 5) = .Fields("productUnit")
                    End If
                    If Not IsNull(.Fields("price")) Then
                      flexGrd.TextMatrix(flexGrd.row, 7) = .Fields("price")
                    End If
                    If IsNumeric(flexGrd.TextMatrix(flexGrd.row, 6)) And IsNumeric(flexGrd.TextMatrix(flexGrd.row, 7)) Then
                        flexGrd.TextMatrix(flexGrd.row, 8) = Val(flexGrd.TextMatrix(flexGrd.row, 7)) * Val(flexGrd.TextMatrix(flexGrd.row, 6))
                        flexGrd.TextMatrix(flexGrd.row, 8) = Format(flexGrd.TextMatrix(flexGrd.row, 8), g_barcode_weight_scale)
                    End If
                    If Trim(flexGrd.TextMatrix(flexGrd.row, 9)) = "" Then
                      flexGrd.TextMatrix(flexGrd.row, 9) = Val(flexGrd.TextMatrix(flexGrd.row, 7))
                    End If
                    If Trim(flexGrd.TextMatrix(flexGrd.row, 10)) = "" Then
                        flexGrd.TextMatrix(flexGrd.row, 10) = "1"
                    End If
                    flexGrd.TextMatrix(flexGrd.row, 11) = Val(flexGrd.TextMatrix(flexGrd.row, 9)) + Val(flexGrd.TextMatrix(flexGrd.row, 10)) * netWeight
                    flexGrd.TextMatrix(flexGrd.row, 9) = Format(flexGrd.TextMatrix(flexGrd.row, 9), g_barcode_weight_scale)
                    flexGrd.TextMatrix(flexGrd.row, 11) = Format(flexGrd.TextMatrix(flexGrd.row, 11), g_barcode_weight_scale)
            
                    If Not IsNull(.Fields("productId")) Then
                      flexGrd.TextMatrix(flexGrd.row, 13) = .Fields("productId")
                    End If
                   strBarcode = flexGrd.Text        '赋值给text1
              End If
         End If
     End With
'     fillTotalDataFromDtlData
'    Call frm_main.movereturn     '调用函数
'    If (flexGrd.row = flexGrd.rows - flexGrd.FixedRows) Then
'        flexGrd.rows = flexGrd.rows + 1
'        flexGrd.TextMatrix(flexGrd.rows - flexGrd.FixedRows, 0) = flexGrd.rows - flexGrd.FixedRows + m_prevBillNo
'    End If
'    flexGrd.row = flexGrd.row + 1: flexGrd.col = 1
End Sub