Read/Write Data from Excel to SQL Server, with Custom Menu.

Read from SQL Server:

 1 Sub Read_SQL()
 2     
 3     Dim i As Integer, j As Integer, sht As Worksheet
 4     Dim cn As New ADODB.Connection
 5     Dim rs As New ADODB.Recordset  '定义记录集对象，保存数据表
 6     Dim strCn As String, strSQL As String    '字符串变量
 7 
 8     strCn = "Provider=sqloledb;Server=10.15.22.87;Database=northwind;Uid=sa;Pwd=password;"
 9 
10     strSQL = "select  OrderID,ShipName from  Orders"
11     cn.Open strCn   '与数据库建立连接，如果成功，返回连接对象cn
12     rs.Open strSQL, cn  '执行strSQL所含的SQL命令，结果保存在rs记录集对象中
13     i = 1
14     
15     Set sht = ThisWorkbook.Worksheets("sheet1")   '把sht指向当前工作簿的sheet1工作表
16     sht.Range("A65536").Clear
17     Do While Not rs.EOF     '当数据指针未移到记录集末尾时，循环下列操作
18         sht.Cells(i, 1) = rs("OrderID")    '把当前记录的字段1的值保存到sheet1工作表的第i行第1列
19         sht.Cells(i, 2) = rs("ShipName")    '把当前字段2的值保存到sheet1工作表的第i行第2列
20         rs.MoveNext                      '把指针移向下一条记录
21         i = i + 1                        'i加1，准备把下一记录相关字段的值保存到工作表的下一行
22     Loop                                 '循环
23     rs.Close
24 
25     cn.Close  '关闭数据库链接,释放资源
26 End Sub

Write to SQL Server:

 1 Sub TO_SQL()
 2     Dim i As Integer, j As Integer, sht As Worksheet    'i,j为整数变量；sht 为excel工作表对象变量，指向某一工作表
 3     Dim cn As New ADODB.Connection    '定义数据链接对象 ，保存连接数据库信息；请先添加ADO引用
 4     Dim rs As New ADODB.Recordset  '定义记录集对象，保存数据表
 5     Dim strCn As String, strSQL As String    '字符串变量
 6 
 7     strCn = "Provider=sqloledb;Server=192.168.0.242;Database=SalesData;Uid=sa;Pwd=password;"
 8     
 9     cn.Open strCn
10 
11     Set sht = ThisWorkbook.Worksheets("sheet1")   '把sht指向当前工作簿的sheet1工作表
12     
13     strSQL = ""
14     For i = 2 To 978 ' sht.Range("A65536").End(x1Up).Row
15        If sht.Cells(i, 1) <> "" Then
16        strSQL = strSQL & " insert into Z_SO(凭证,项目,物料,订单数量,净价值,售达方,交货日期,创建日期) values ( '" _
17                        & sht.Cells(i, 1) & "' , '" _
18                        & sht.Cells(i, 2) & "' , '" _
19                        & sht.Cells(i, 3) & "' , '" _
20                        & sht.Cells(i, 4) & "' , '" _
21                        & sht.Cells(i, 5) & "' , '" _
22                        & sht.Cells(i, 6) & "' , '" _
23                        & sht.Cells(i, 7) & "' , '" _
24                        & sht.Cells(i, 8) & "'    " _
25                        & ") ;"
26        End If
27     Next i
28 
29     cn.Execute strSQL  '执行该SQL命令串，如果SQL命令没有错误，将在数据库中添加501个记录;也可以用rs.open strSQL,cn 执行
30     
31     '删除订单号、行号相同的行
32     
33     cn.Close  '关闭数据库链接,释放资源
34 End Sub

Menu in Excel:

  1 Sub AddNewMenu()
  2     Dim HelpMenu As CommandBarControl
  3     Dim NewMenu As CommandBarPopup
  4     Dim MenuItem As CommandBarControl
  5     Dim SubMenuItem As CommandBarButton
  6     
  7     On Error Resume Next
  8     '如果菜单已存在,则删除该菜单
  9     CommandBars(1).Controls("石化服务销售中心(&S)").Delete
 10     CommandBars(1).Controls("统计(&S)").Delete
 11     
 12     '利用ID属性查找帮助菜单
 13     Set HelpMenu = CommandBars(1).FindControl(ID:=30010)
 14     
 15     If HelpMenu Is Nothing Then
 16         '如果该菜单不存在,则将新菜单添加到末尾
 17         '设置新菜单为临时的
 18         Set NewMenu = CommandBars(1).Controls _
 19           .Add(Type:=msoControlPopup, Temporary:=True)
 20     Else
 21         '将新菜单添加到帮助菜单之前
 22         Set NewMenu = CommandBars(1).Controls _
 23           .Add(Type:=msoControlPopup, Before:=HelpMenu.Index, _
 24           Temporary:=True)
 25     End If
 26     
 27     '添加菜单标题并指定热键
 28     NewMenu.Caption = "石化服务销售中心(&S)"
 29     
 30     '添加第一个菜单项
 31     Set MenuItem = NewMenu.Controls.Add _
 32       (Type:=msoControlButton)
 33     With MenuItem
 34         .Caption = "导入物料主数据(&D)"
 35         .FaceId = 162
 36         .OnAction = "Macro1"
 37     End With
 38     '添加第一个菜单项
 39     Set MenuItem = NewMenu.Controls.Add _
 40       (Type:=msoControlButton)
 41     With MenuItem
 42         .Caption = "导入客户主数据(&D)"
 43         .FaceId = 162
 44         .OnAction = "Macro1"
 45     End With
 46     '添加第一个菜单项
 47     Set MenuItem = NewMenu.Controls.Add _
 48       (Type:=msoControlButton)
 49     With MenuItem
 50         .Caption = "导入销售订单(&D)"
 51         .FaceId = 162
 52         .OnAction = "Macro1"
 53     End With
 54     '添加第一个菜单项
 55     Set MenuItem = NewMenu.Controls.Add _
 56       (Type:=msoControlButton)
 57     With MenuItem
 58         .Caption = "导入已过账的交货单(&D)"
 59         .FaceId = 162
 60         .OnAction = "Macro1"
 61     End With
 62     
 63     '添加第二个菜单项
 64     Set MenuItem = NewMenu.Controls.Add _
 65       (Type:=msoControlButton)
 66     With MenuItem
 67         .Caption = "汇总数据(&T)"
 68         '添加快捷键
 69         .ShortcutText = "Ctrl+Shift+T"
 70         .FaceId = 590
 71         .OnAction = "Macro2"
 72     End With
 73     
 74     '添加第三个菜单项
 75     '本菜单有子菜单项,因此其类型为msoControlPopup
 76     Set MenuItem = NewMenu.Controls.Add _
 77       (Type:=msoControlPopup)
 78     With MenuItem
 79         .Caption = "数据报表(&R)"
 80         '添加分隔线
 81         .BeginGroup = True
 82     End With
 83     
 84     '添加子菜单
 85     '添加第一个子菜单
 86     Set SubMenuItem = MenuItem.Controls.Add _
 87       (Type:=msoControlButton)
 88     With SubMenuItem
 89         .Caption = "月汇总(&M)"
 90         .FaceId = 110
 91         .OnAction = "Macro3"
 92     End With
 93     
 94     '添加第二个子菜单
 95     Set SubMenuItem = MenuItem.Controls.Add _
 96       (Type:=msoControlButton)
 97     With SubMenuItem
 98         .Caption = "季度汇总(&Q)"
 99         .FaceId = 222
100         .OnAction = "Macro4"
101     End With
102 End Sub

Demo: