VBA实战：电商仓储错拣逆还及退货上架（中）

接上讲-直接写功能实现

一、连接数据库可以直接参考我之前写的vba连接sql,只需要修改一下查询的sql语句就可以了；

此部分直接写在模块中，记得引用库；以下直接贴出：

 1 '工具-引用--by OcarinaZhang
 2 'Microsoft ActiveX Data Objects 2.8 Libary
 3 'Microsoft ActiveX Data Objects Record我s 2.8 Libary
 4 'Microsoft ADO Ext.2.8 For Dll and Security
 5 'Microsoft Forms 2.0 Object Libary
 6 Public cat As New ADOX.Catalog
 7 Public Conn As New ADODB.Connection 
 8 Public rs As New ADODB.Recordset 
 9 Public Strsql As String            
10 
11 '打开连接
12 Public Sub OpenSql()
13 If Conn.State = 1 Then Conn.Close
14 If Conn.State = 0 Then
15     Conn.Open "provider=sqloledb;server=192.168.1.254(数据库的IP地址，此地址可以是公网IP实现远程访问);database=数据库名称;uid=登录数据库的帐号;pwd=登录密码;"
16 End If
17 End Sub
18 
19 '关闭连接
20 Public Sub CloseConn()
21 rs.Close
22 Conn.Close
23 End Sub
24 
25 '查询设计
26 Public Sub SelectView(sku As String)
27 '以下是在数据库中以采集的条形码查询库位whid，建议写成存储过程，在VBA中直接调用
28 Strsql = "select '" & sku & "' as inco,whid from inwh where inco='" & sku & "'"
29 OpenSql '打开连接
30 rs.Open Strsql, Conn '使用连接
31 Worksheets("sys").Cells.Clear
32 Dim i As Integer     '写入到SYS表
33 For i = 0 To rs.Fields.Count - 1
34     Worksheets("sys").Cells(1, i + 1).Value = rs.Fields(i).Name
35 Next i
36 Worksheets("sys").Cells(2, 1).CopyFromRecordset rs
37 CloseConn '关闭连接
38 End Sub

数据库部分完成，这一段是写入在模块中的，方便直接调用

二、确认按钮

 1 '确认按钮--by OcarinaZhang
 2 Private Sub CommandButton1_Click()
 3 Dim cnt%, i%, str$, whco$
 4 '加入朗读提示音
 5 Dim oSp As Object
 6 Set oSp = CreateObject("SAPI.SpVoice")
 7 oSp.Rate = 3    '朗读速度
 8 Dim rng As Range
 9 Dim rngg As Range
10 If nCount.Value = "" Then
11     nCount.Value = 0
12 End If
13 'begin
14 str = UCase(sku.Value)
15 If str = "YY" Then    '加入打印码YY，通常打印张贴于拣货车上作最后的快捷打印 这个IF块也可以单独写成printSub打印子过程，赋给打印按钮，此处直接使用call printSub调用也可
16     oSp.Speak "打印上架单，请稍候"
17     '给标题
18     Worksheets("sheet1").[a1].Value = "库位名称"
19     Worksheets("sheet1").[b1].Value = "拣货车序号"
20     '排序：库位升序排序，有标题行
21     Range("a:b").Sort Range("a1"), xlAscending, Header:=xlYes
22     '确认打印范围并打印
23     i = Worksheets("sheet1").[a65535].End(xlUp).Row
24     Worksheets("sheet1").Range("a1:b" & i).PrintOut
25     '清空sheet1数据
26     Worksheets("sheet1").Cells.Clear
27     nCount.Value = ""
28     sku.Value = ""
29     whid.Value = ""
30     sku.Value = ""
31     sku.SetFocus
32     Exit Sub
33 End If
34 Call SelectView(sku)   '查询
35 If Not Worksheets("sys").[a2] = "" Then
36     cnt = nCount.Value + 1
37     nCount.Value = cnt
38     whco = Worksheets("sys").[b2].Value
39     whid.Value = whco
40     Set rngg = Worksheets("sheet1").Range("A:A").Find(whco, lookat:=xlWhole)
41     If Not rngg Is Nothing Then   '库位存在
42         rngg.Offset(0, 1).Value = rngg.Offset(0, 1).Value & "," & cnt
43     Else
44         Set rng = Worksheets("sheet1").[a65535].End(xlUp)
45         rng.Offset(1, 0).Value = Worksheets("sys").[b2].Value
46         rng.Offset(1, 1).Value = cnt
47     End If
48     oSp.Speak cnt  '可以用其它提示音函数替换，不过这个可以和拣货车上的序号做复核确认
49 Else
50     Call errorsec       '条码不存在则报错，通常由扫描枪乱码导致:可替换：oSp.Speak "错误，请重试"
51 End If
52 
53 sku.SetFocus        '选中采集框，可以用 sku.value="" ,sku.setfocus替换这三行
54 sku.SelStart = 0
55 sku.SelLength = Len(sku.Value)
56 
57 End Sub