编码查询工具（进阶）

块定义

Option Explicit

Type VMCode

    prd_no As String '编码

    spc As String '具体规格

    ut As String '单位

End Type

Type VCode

    prd_no As String '编码

    PRD_MARK As String '供应商

    qty As Single '现有库存

    qty_on_way As Single '在途

    qty_on_prc As Single '在制

    qty_on_rsv As Single '未发量

    qty_end As Single '可用库存

    name As String '库位

End Type

主程序

Option Explicit

Private Declare Function LCMapstring Lib "kernel32" Alias "LCMapStringA" (ByVal locale As Long, ByVal dwpflags As Long, ByVal lpsrcstr As String, ByVal cchsrc As Long, ByVal lpdeststr As String, ByVal cchdest As Long) As Long

Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpstring As String) As Long

Dim stf As String

Dim stj As String

Dim stlen As String

Dim cnn As ADODB.Connection

Dim DataTemp() As VMCode

Dim DTemp() As VCode

Private Sub Combo1_Click()

Dim rs As ADODB.Recordset

Dim rst1 As ADODB.Recordset

Dim sql1 As String

Dim stf1 As String

Dim stj1 As String

Dim stlen1 As String

Dim sql2 As String

Dim i, x, y As Integer

Dim str2 As String

    Set rs = New ADODB.Recordset

    Text1.Text = DataTemp(Combo1.ListIndex).prd_no

    Label4.Caption = "单位:" & DataTemp(Combo1.ListIndex).ut

    sql1 = "select PRD_NO,PRD_MARK,QTY,QTY_ON_WAY,QTY_ON_PRC,QTY_ON_RSV,WH from dbo.prdt1 where '" & Trim(Text1.Text) & "' = prd_no"

    rs.Open Trim$(sql1), cnn, adOpenKeyset, adLockOptimistic

    If rs.RecordCount <> 0 Then

        ReDim DTemp(rs.RecordCount - 1)

        ReDim str1(0 To rs.RecordCount - 1)

        x = rs.RecordCount

        List1.Clear

        rs.MoveFirst

        For i = 0 To rs.RecordCount - 1

            DTemp(i).PRD_MARK = rs.Fields(1) & Space(7 - Len(rs.Fields(1)))

            DTemp(i).prd_no = rs.Fields(0)

            DTemp(i).qty = rs.Fields(2)

            str1(i) = DTemp(i).qty & Space(10 - Len(Str(DTemp(i).qty)))

            DTemp(i).qty_on_way = rs.Fields(3)

            DTemp(i).qty_on_prc = rs.Fields(4)

            DTemp(i).qty_on_rsv = rs.Fields(5)

            DTemp(i).name = rs.Fields(6)

            DTemp(i).qty_end = DTemp(i).qty + DTemp(i).qty_on_way + DTemp(i).qty_on_prc - DTemp(i).qty_on_rsv

            'rst1.Open Trim$(sql2), cnn, adOpenKeyset, adLockOptimistic

            'List1.AddItem "供应商:" & DTemp(i).PRD_MARK & "现有库存:" & str1(i) & "可用库存:" & DTemp(i).qty_end & vbCrLf

            rs.MoveNext

        Next i

        rs.Close

        Set rs = Nothing

        For y = 0 To x - 1

        Set rst1 = New ADODB.Recordset

        sql2 = "select wh,name from dbo.MY_WH where '" & Trim(DTemp(y).name) & "' = wh"

        rst1.Open Trim$(sql2), cnn, 3, 2

        If rst1.RecordCount <> 0 Then

        stf1 = rst1.Fields(1)

        stlen1 = lstrlen(stf1)

        stj1 = Space(stlen1)

        LCMapstring &H804, &H2000000, stf1, stlen1, stj1, stlen1

        str2 = stj1

        List1.AddItem "库位:" & str2 & " 供应商:" & DTemp(y).PRD_MARK & "现有库存:" & str1(y) & "可用库存:" & DTemp(y).qty_end & vbCrLf

        End If

        rst1.Close

        Set rst1 = Nothing

        Next y

    Else:

        List1.Clear

        List1.AddItem "无库存"

    End If

End Sub

Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)

Dim VarString

Dim dbFilePath As String

'Dim cnn As ADODB.Connection

Dim rst As ADODB.Recordset

Dim SQL As String

Dim i As Integer

dbFilePath = "FileDSN=db_tz13.dsn;UID=sa;PWD=sqlsa"   'server 192.168.1.12

If KeyCode = 13 Then

    Text1.Text = ""

    If Combo1.Text <> "" Then

        VarString = Split(Combo1.Text, " ") 'split是一个切割函数

        Combo1.Clear

        SQL = "SELECT prd_no,spc,ut FROM DBO.PRDT WHERE "

        For i = 0 To UBound(VarString)

            stj = VarString(i)

            stlen = lstrlen(stj)

            stf = Space(stlen)

            LCMapstring &H804, &H4000000, stj, stlen, stf, stlen

            VarString(i) = stf

            If i <> 0 Then

                SQL = SQL & " and "

            End If

            SQL = SQL & "CHARINDEX(N'" & Trim(VarString(i)) & "',spc)<>0"

'N 在这里表示 Unicode，就是双字节字符。对于西文字符，用一个字节来存储过足够了，对于东方文字，就需要两个字节来存储。字符串用引号，公式用& &，字符型数据用单引号

        Next i

        SQL = SQL & " order by prd_no"

    Else

        Label3.Caption = ""

        Exit Sub

    End If

Else

    Exit Sub

End If

On Error GoTo ExecuteSQL_Error

Set cnn = New ADODB.Connection

cnn.Open dbFilePath

cnn.Execute "use db_tz13"

Set rst = New ADODB.Recordset

rst.Open Trim$(SQL), cnn, adOpenKeyset, adLockOptimistic

'Rs.open语法：rs.open Source(sql语句),ActiveConnection(数据库连接),CursorType(游标),LockType(数据锁定类型)

'Set rs = New ADODB.Recordset

'SQL1 = "select prd_no,qty from dbo.prdt1 where rst.fields(0)=prd_no "

'rs.Open SQL1, cnn, adOpenKeyset, adLockOptimistic

If rst.RecordCount <> 0 Then

    ReDim DataTemp(rst.RecordCount - 1)

    Label3.Caption = "找到符合条件的 " & rst.RecordCount & "条记录！"

    rst.MoveFirst

    For i = 0 To rst.RecordCount - 1

        stf = rst.Fields(1)

        stlen = lstrlen(stf)

        stj = Space(stlen)

        LCMapstring &H804, &H2000000, stf, stlen, stj, stlen

        'Set rs = New ADODB.Recordset

        DataTemp(i).prd_no = rst.Fields(0)

        DataTemp(i).spc = stj

        DataTemp(i).ut = rst.Fields(2)

        'rs.Open "select prd_no,qty from dbo.prdt1 where CHARINDEX(N'" & Trim(DataTemp(i).prd_no) & "',prd_no)<>0", cnn, adOpenKeyset, adLockBatchOptimistic

        'DataTemp(i).qty = rs.Fields(1)

        Combo1.AddItem DataTemp(i).prd_no & " | " & DataTemp(i).spc '& " | 数量:" & rs.Fields(1)

        rst.MoveNext

        'rs.MoveNext

        If i = 100 Then

            i = rst.RecordCount

            Label3.Caption = Label3.Caption & Chr(13) & "请注意仅仅列出前100个记录！"

        End If

    Next i

    'Combo1.Drop

    'SendKeys "{f4}"

Else

    Label3.Caption = "找到符合条件的 0条记录！"

End If

rst.Close

Set rst = Nothing

Exit Sub

ExecuteSQL_Error:

MsgBox "连接服务器失败！", vbOKOnly + vbCritical, "错误！"

End Sub

Private Sub Command1_Click()

Shell "C:\WINDOWS\system32\calc.exe", vbNormalFocus

End Sub