基于VB脚本的扫描器（扫码枪）数据采集对Excel表格快速录入数据
 
前段时间我接到个毕业设计的一部分外包，主要是关于HMI读写扫码枪数据的算法采集；因为业主是用两个不同的平台，造成PC端跟HMI混用。且扫描器也是USB接口与电脑通讯模拟键盘输入。在扫描到条形码后模拟键盘对电脑输入数据。所以我帮忙写了一个VB脚本用来采集数据。
 
由于我也是第一次编写VB的电脑程序，在以前工厂里都是写一点简单的脚本和算法。所以我的思路都比较生硬，欢迎各路大神指教！！
 
采集流程图
 
 
 

1． 业务回顾  客户进行下订单操作 --- > 业务受理  
 
  前端系统 bos_fore 系统客户可以在线下订单  
 
后台系统 bos_management 中系统工作人员，接取客户电话，代替客户进行下订单  
 
在下订单完成后 – 产生工单 （快递员取件任务），由快递员将货物取回快递网点 – 录入运单信息 （包括货物信息、发件人、收件人信息、包装、计费、运输、签收信息 … ）
 
 
2． 快速录入业务
 
  快速录入运单信息 --- 并不是完整运单信息 ，为了物流运输  
 
 
        Datagrid 提供数据表格行录入功能  

1.在这里主要以一个人员薪酬表为例子，做简单的增删改等操作，以及快速生成工资条，窗口示例如下


2.数据表信息如下


3.生成的工资表如下


4.详细代码如下
'添加员工信息
Private Sub CommandButton1_Click()
Dim i
Dim w1
Set w1 = Worksheets(1)


i = 2
While w1.Cells(i, 1) <> ""
i = i + 1
Wend
If TextBox1 = "" Then
MsgBox "工号不能为空！", vbOKOnly
'将对应的信息填写在工作表中
End If
If TextBox1 <> "" Then
w1.Cells(i, 1) = TextBox1.Text
w1.Cells(i, 2) = TextBox2.Text
w1.Cells(i, 3) = ListBox1.Text
w1.Cells(i, 4) = ListBox2.Text
w1.Cells(i, 5) = TextBox3.Text
w1.Cells(i, 6) = TextBox4.Text
End If
MsgBox "添加完成", vbOKOnly
End Sub
'删除员工信息
Private Sub CommandButton2_Click()
Dim i
Dim w1
Set w1 = Worksheets(1)
i = 2
While w1.Cells(i, 1) <> TextBox1.Text And w1.Cells(i, 1) <> ""
 i = i + 1
Wend
'将对应的信息显示在对应的文本框中
    If w1.Cells(i, 1) = TextBox1.Text Then
    TextBox2.Text = w1.Cells(i, 2)
    ListBox1.Text = w1.Cells(i, 3)
    ListBox2.Text = w1.Cells(i, 4)
    TextBox3.Text = w1.Cells(i, 5)
    TextBox4.Text = w1.Cells(i, 6)
    respose = MsgBox("确定删除吗？", vbOKCancel)
             If respose = vbOK Then
            Range("A" & i, "I" & i).Select
            Selection.Delete Shift:=xlUp
            MsgBox "删除完成", vbOKOnly
            End If
            If respose = vbCancel Then
            w1.Cells(i, 1) = TextBox1.Text
            w1.Cells(i, 2) = TextBox2.Text
            w1.Cells(i, 3) = ListBox1.Text
            w1.Cells(i, 4) = ListBox2.Text
            w1.Cells(i, 5) = TextBox3.Text
            w1.Cells(i, 6) = TextBox4.Text
    
            End If
    End If
    If w1.Cells(i, 1) <> TextBox1.Text Then
    MsgBox "未找到该工号，请确认工号是否有误！"
    End If
End Sub
'修改员工信息
Private Sub CommandButton3_Click()
Dim i
Dim w1
Set w1 = Worksheets(1)
i = 2
While w1.Cells(i, 1) <> TextBox1.Text And w1.Cells(i, 1) <> ""
 i = i + 1
Wend
    If w1.Cells(i, 1) = TextBox1.Text Then
    TextBox2.Text = w1.Cells(i, 2)
    ListBox1.Text = w1.Cells(i, 3)
    ListBox2.Text = w1.Cells(i, 4)
    TextBox3.Text = w1.Cells(i, 5)
    TextBox4.Text = w1.Cells(i, 6)
    respose = MsgBox("确定修改吗？", vbOKCancel)
             If respose = vbOK Then
            w1.Cells(i, 1) = TextBox1.Text
            w1.Cells(i, 2) = TextBox2.Text
            w1.Cells(i, 3) = ListBox1.Text
            w1.Cells(i, 4) = ListBox2.Text
            w1.Cells(i, 5) = TextBox3.Text
            w1.Cells(i, 6) = TextBox4.Text
            MsgBox "修改完成", vbOKOnly
            End If
            If respose = vbCancel Then
    
            End If
    End If
     If w1.Cells(i, 1) <> TextBox1.Text Then
    MsgBox "未找到该工号，请确认工号是否有误！"
    End If
End Sub
'一键生成工资表
Private Sub CommandButton4_Click()
Dim i, j
Dim w1, w3
Set w1 = Worksheets(1)
Set w3 = Worksheets(3)
i = 1
j = 1
While w1.Cells(i, 1) <> ""
i = i + 1
Wend
While w1.Cells(1, j) <> ""
j = j + 1
Wend
'将数据复制到指定工作表
Sheets("Sheet1").Activate
Sheets("Sheet1").Range(Cells(1, 1), Cells(i, j)).Select
 Selection.Copy
    Sheets("Sheet3").Select
    Range("A1").Select
    ActiveSheet.Paste
    i = 2
'插入标题行
    While w3.Cells(i, 1) <> ""
  
        If (i Mod 2) = 1 Then
       w3.Range(Cells(1, 1), Cells(1, j)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Activate
    Sheets("Sheet3").Range("A" & i).Select
    Selection.Insert Shift:=xlDown
    End If
        i = i + 1
    Wend
    i = 2
    '插入空白行
    While Cells(i, 1) <> ""
        If (i Mod 3) = 0 Then
         Sheets("Sheet3").Activate
         Sheets("Sheet3").Range("A" & i).Select
         Application.CutCopyMode = False
         Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
         End If
    i = i + 1
    Wend
End Sub

示例   
 
Access是微软Office组件的数据库软件，使用它可以进行简单的数据库软件的开发。但Access的图表功能和数据分析功能不如Excel强大，常用的做法可以将Access中的数据导入
 Excel中再进行处理。如何使用VBA导入Access的数据？如图所示，该表为Access中某个公司的加工数据表。
 

  加工记录
 
ID
日期
型号
规格
加工人
数量
25
2010/12/27 星期一
ZPSZ
350*500*2800
王小虎
15
26
2010/12/27 星期一
ZPSZ
250*300*2900
张兵
31
27
2010/12/27 星期一
ZPSZ
250*300*3000
何志刚
22
28
2010/12/27 星期一
ZPSZ
300*400*2800
林杰
25
29
2010/12/27 星期一
BPS
300*400*2900
刘建军
17
30
2010/12/27 星期一
BPS
300*400*3500
何腾壮
27
31
2010/12/27 星期一
ZPSZ
300*400*3500
陈德群
26
32
2010/12/27 星期一
ZPSZ
250*300*3500
朱章兵
33
33
2010/12/28 星期二
ZPSZ
350*500*2800
叶胜
39
34
2010/12/27 星期一
ZPSZ
250*300*2900
吕金军
24
35
2010/12/27 星期一
ZPSZ
250*300*3000
丁敬新
15
36
2010/12/28 星期二
ZPSZ
300*400*2800
王小虎
23
37
2010/12/27 星期一
BPS
300*400*2900
张兵
28
38
2010/12/27 星期一
BPS
300*400*3500
何志刚
10
39
2010/12/28 星期二
ZPSZ
300*400*3500
林杰
11
40
2010/12/27 星期一
ZPSZ
250*300*3500
刘建军
33
41
2010/12/28 星期二
ZPSZ
300*400*3500
何腾壮
28
42
2010/12/27 星期一
ZPSZ
250*300*3500
陈德群
32
43
2010/12/27 星期一
BPS
300*400*2900
朱章兵
36
44
2010/12/28 星期二
BPS
300*400*3500
叶胜
30
45
2010/12/27 星期一
ZPSZ
300*400*3500
吕金军
21
46
2010/12/28 星期二
ZPSZ
250*300*3500
丁敬新
32
47
2010/12/28 星期二
ZPSZ
350*500*2800
叶胜
39
48
2010/12/28 星期二
ZPSZ
300*400*2800
王小虎
23
49
2010/12/28 星期二
ZPSZ
300*400*3500
林杰
11
50
2010/12/28 星期二
ZPSZ
300*400*3500
何腾壮
28
51
2010/12/28 星期二
BPS
300*400*3500
叶胜
30
52
2010/12/28 星期二
ZPSZ
250*300*3500
丁敬新
32
代码
 
    利用ADO组件可以方便地对各种数据进行连接和访问。ADO组件中的Connection对象可以实现对数据库的连接，并可以快速实现SQL语句的执行，然后再用VBA将SQL查询的结果输出到Excel表格中。
     打开VBE窗口，选择菜单“工具”一“引用”，勾选Microsoft ActiveX Data Objects 2.8Library，并单击“确定”按钮。
 
Option Explicit

Sub 导入Access数据()
    Dim AdoConn As New ADODB.Connection
    Dim strConn As String
    Dim strSql As String
    
    '设置连接字符串
    strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & ThisWorkbook.Path & Application.PathSeparator & _
            "数据库.accdb;"
    '设置SQL查询语句
    strSql = "Select * From 型号规格"
    
    '打开数据库连接
    AdoConn.Open strConn
    
    '执行查询，并将结果输出到当前表格A1
    ActiveSheet.Range("A1").CopyFromRecordset AdoConn.Execute(strSql)
    
    '关闭连接
    AdoConn.Close
End Sub
 
利用ADO连接数据库
 
    ADO的全称是ActiveX Data Object，是一个用于存取数据源的COM组件，用以快速实现各种数据库的连接、读取、写入。在ADO组件中有一个Connection对象，利用Connection对象的Open方法可以实现数据库的连接。Open方法的语法如下：
 
Connection．Open 连接文本，用户名，密码，选项
 
连接文本：一个包含有关连接的信息的字符串。
用户名：一个字符串，包含建立连接时要使用的用户名称。
密码：一个字符串，包含建立连接时要使用的密码。
选项：一个整型数值，确定应在建立连接之后（同步）还是在建立连接之前（异步）返回本方法。-1（默认）代表同步打开连接，16代表异步打开连接。
 
利用ADO执行SQL查询并在Excel中输出结果
 
    连接数据库之后，即可利用ADO组件中Connection对象的Execute方法执行SQL语句查询，并将结果写入工作表中，其格式为：
 
Range.CopyFromRecordset AdoConn.Execute(SQL{吾句)
 
    其中，Range为结果输出的起始点，即结果数据最左上角所在的单元格，SQL语句为执行查询的SQL语句。
 
  利用该输出方式将结果写入工作表中时，其结果是没有标题行（字段名）的。
 
SQL语句
 
    SQL (Structured Query Language)即结构化查询语言，是关系数据库的标准语言。许多流行的数据库均支持SQL语句的查询，在微软Office系统的Excel与Access中支持SQL语句
 对数据进行查询、修改操作等。
 
ADO连接不同的数据库
 
    利用ADO可以实现多种数据库的连接，只需改变连接字符串中的参数即可。本例中以连接Access 2007以上的数据库为例，若要连接Access 2003数据库，可以采用以下连接：
 
strConn="Provider=Microsoft.Jet.OLEDB.4.0; " & _
        "Data Source=" & ThisWorkbook.Path & Application.PathSeparator & "数据库．mdb"
 
对于带有密码的Access数据库，2007以上版本和2003版本的连接字符串分别如下：
 
strConn="Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "DataSource=" & ThisWorkbook.Path & _
         Application.PathSeparator & "; Jet OLEDB;" & _
         "Database Password=密码；¨
 
strConn = "Privider=microsoft.oledb.4.0;" & _
          "Data source=" & thisworkbok.Path & Application.PathSeparator & _
          ";Jet OLEDB:database password=密码"
 
  连接Excel 2007以上版本的工作簿，可以采用以下连接字符串：
 
strConnExcel2007 = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                    "Data Source=" & ThisWorkbook.Path & Application.PathSeparator & _
                    "数据库.xls;Extended Properties=""Excel 12.0;HDR=YES"";"
                    

strconexcel2003 = "Provider=Microsoft.ACE.OLEDB.4.0;" & _
                  "Data Source=" & ThisWorkbook.Path & Application.PathSeparator & _
                  "数据库.xls;Extended Properties=""Excel 8.0;HDR=YES"";"
 
    其中，HDR=YES表示数据中的第一行为列（字段）的名称，如果省略该参数或者HDR=No，那么将认为表格中是数据，没有列名。
     对于Excel 2007及以上的版本，设置为Excel 12.0；Excel 2007之前的版本，则设置为Excel 8.0。对于带有密码保护的Excel工作簿，ADO无法打开，只有当该工作簿已经打开时，ADO才可以正常连接。
连接文本文件时，可以采用以下连接字符串：
 
strconnTxt = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
             "Data Source=" & ThisWorkbook.Path & Application.PathSeparator & _
             ";Extended Properties=TEXT;"
 
    参数Data Source为包含文本文件的目录名，而不是文件名称。如果文本文件的第一行不包含字段名称，则必须在参数Extended Properties中加HDR=No，以避免丢失第一行的数据。
 当连接文本文件进行SQL查询时，查询语句中的数据表即为设定目录下的文本文件。以文本文件“数据库.Txt”为例，SQL语句应按照如下格式书写：
 
SELECT * FROM [数据库#Txt]
 
若要连接SQL Server数据库，可以采用以下连接字符串：
 
strConn="Provider=SQLOLEDB;" & _
" Data Source=ServerName\InstanceName;" & _
"Initial Catalog=DatabaseName;" & _
"User ID=UserName;" & _
"Password=password; "