編碼查詢工具（進階）

塊定義

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