下面的VBA是将快表中查询到的明细数据通过金蝶云星空API接口发送的示例供参考！

1. Imports SpreadsheetGear
   
2. Imports C1.Silverlight
   
3. Imports C1.Silverlight.C1MessageBoxButton
   
4. Imports C1.Silverlight.C1MessageBoxIcon
   
5. Imports Newtonsoft.Json
   
6. Imports Newtonsoft.Json.Linq
   
7. Imports Microsoft.VisualBasic
   
8. Imports System.IO
   
9. Imports System.Text
   
10. Imports System.Net
    
11. Imports System.Windows.forms
    
12. Imports System.Threading.Tasks
    
13. 
    
14. Namespace ExcelViewVBDotnet
    
15.    Public Class StandardInterface
    
16.        '预留位置1
    
17.        '预留位置2
    
18.        Dim EV As SpreadsheetGear.Windows.Controls.WorkbookView,AW As SpreadsheetGear.IWorkbook,Range As SpreadsheetGear.IRange
    
19.        Dim PushUrl As String = "http://192.168.0.1:8888/api/WebApi/PushCGRKD"
    
20. 
    
21.        Public Sub Workbook_Open(OldRoot As Object,NewRoot As Object,Excel As SpreadsheetGear.Windows.Controls.WorkbookView)
    
22.            EV = Excel
    
23.            Excel.GetLock()
    
24.            AW = Excel.ActiveWorkbook
    
25.            Range = AW.ActiveWorksheet.Range
    
26.            Excel.ReleaseLock()
    
27.        End Sub'打开时执行事件
    
28. 
    
29.        Public Sub RangeSelection(sender As Object,e As SpreadsheetGear.Windows.Controls.RangeSelectionChangedEventArgs)
    
30. 
    
31.        End Sub'单元格选择后执行的事件
    
32. 
    
33.        Public Sub RangeChanged(sender As Object,e As SpreadsheetGear.Windows.Controls.RangeChangedEventArgs)
    
34. 
    
35.        End Sub'单元格编辑完成后执行事件
    
36. 
    
37.        Public Sub ButtunClick(sender As Object,e As SpreadsheetGear.Windows.Controls.ShapeActionEventArgs)
    
38.             If e.Shape.Name = "发送" Then
    
39.                 Dim payload As String = ""
    
40. 
    
41.                 Try
    
42.                     EV.GetLock()
    
43.                     If EV.RangeSelection Is Nothing OrElse EV.RangeSelection.Cells(0,0).Value Is Nothing Then
    
44.                         EV.ReleaseLock()
    
45.                         C1MessageBox.Show("请选择一个包含JSON字符串的单元格。", "提示", OK, C1MessageBoxIcon.Warning)
    
46.                         Return
    
47.                     End If
    
48. 
    
49.                     payload = EV.RangeSelection.Cells(0,0).Text
    
50.                     EV.ReleaseLock()
    
51.                 Catch ex As Exception
    
52.                     Try
    
53.                         EV.ReleaseLock()
    
54.                     Catch
    
55.                     End Try
    
56.                     C1MessageBox.Show("读取单元格失败：" + ex.Message, "错误", OK, C1MessageBoxIcon.Error)
    
57.                     Return
    
58.                 End Try
    
59. 
    
60.                 If payload Is Nothing OrElse payload.Trim() = "" Then
    
61.                     C1MessageBox.Show("单元格内容为空，请填入要推送的JSON字符串。", "提示", OK, C1MessageBoxIcon.Warning)
    
62.                     Return
    
63.                 End If
    
64. 
    
65.                 Try
    
66.                     JToken.Parse(payload)
    
67.                 Catch ex As Exception
    
68.                     C1MessageBox.Show("JSON格式无效：" + ex.Message, "提示", OK, C1MessageBoxIcon.Warning)
    
69.                     Return
    
70.                 End Try
    
71. 
    
72.                 Dim client As New WebClient()
    
73.                 client.Encoding = Encoding.UTF8
    
74.                 client.Headers("Content-Type") = "application/json; charset=utf-8"
    
75.                 AddHandler client.UploadStringCompleted, AddressOf PushCompleted
    
76. 
    
77.                 Try
    
78.                     client.UploadStringAsync(New Uri(PushUrl, UriKind.Absolute), "POST", payload)
    
79.                 Catch ex As Exception
    
80.                     C1MessageBox.Show("发送失败：" + ex.Message, "错误", OK, C1MessageBoxIcon.Error)
    
81.                 End Try
    
82.             End If
    
83.        End Sub'按钮/标签点击事件
    
84. 
    
85.        Public Sub FollowHyperlink(sender As Object)
    
86. 
    
87.        End Sub '暂不支持
    
88. 
    
89.        Private Sub PushCompleted(sender As Object, e As UploadStringCompletedEventArgs)
    
90.             If e.Error IsNot Nothing Then
    
91.                 C1MessageBox.Show("接口调用失败：" + e.Error.Message, "错误", OK, C1MessageBoxIcon.Error)
    
92.                 Return
    
93.             End If
    
94. 
    
95.             If e.Result Is Nothing OrElse e.Result.Trim() = "" Then
    
96.                 C1MessageBox.Show("接口无返回内容。", "提示", OK, C1MessageBoxIcon.Warning)
    
97.                 Return
    
98.             End If
    
99. 
    
100.             Try
     
101.                 Dim jr As JObject = CType(JsonConvert.DeserializeObject(e.Result), JObject)
     
102.                 Dim msg As String = ""
     
103.                 Dim detailMsg As String = ""
     
104.                 Dim successText As String = ""
     
105. 
     
106.                 If jr.Item("Message") IsNot Nothing Then
     
107.                     msg = jr.Item("Message").ToString()
     
108.                 End If
     
109. 
     
110.                 If jr.Item("Success") IsNot Nothing Then
     
111.                     successText = jr.Item("Success").ToString()
     
112.                 End If
     
113. 
     
114.                 If jr.Item("Details") IsNot Nothing Then
     
115.                     Dim arr As JArray = CType(jr.Item("Details"), JArray)
     
116.                     If arr.Count > 0 Then
     
117.                         Dim item As JObject = CType(arr(0), JObject)
     
118.                         If item.Item("DocNo") IsNot Nothing Then
     
119.                             detailMsg = "单号：" + item.Item("DocNo").ToString()
     
120.                         End If
     
121.                         If item.Item("Message") IsNot Nothing Then
     
122.                             If detailMsg <> "" Then
     
123.                                 detailMsg = detailMsg + vbCrLf
     
124.                             End If
     
125.                             detailMsg = detailMsg + item.Item("Message").ToString()
     
126.                         End If
     
127.                     End If
     
128.                 End If
     
129. 
     
130.                 If successText = "True" OrElse successText = "true" Then
     
131.                     C1MessageBox.Show(msg + vbCrLf + detailMsg, "推送成功", OK, C1MessageBoxIcon.Information)
     
132.                 Else
     
133.                     C1MessageBox.Show(msg + vbCrLf + detailMsg, "推送失败", OK, C1MessageBoxIcon.Warning)
     
134.                 End If
     
135.             Catch ex As Exception
     
136.                 C1MessageBox.Show("返回解析失败：" + ex.Message + vbCrLf + e.Result, "错误", OK, C1MessageBoxIcon.Error)
     
137.             End Try
     
138.        End Sub
     
139. 
     
140.    End Class
     
141. '  注：除事件字眼下可以自定义代码外的所有代码不允许改动，否则编译将有可能失败。
     
142. End Namespace

复制代码

下面的VBA是将快表中查询到的明细数据通过金蝶云星空API接口发送的示例供参考！

1. Imports SpreadsheetGear
   
2. Imports C1.Silverlight
   
3. Imports C1.Silverlight.C1MessageBoxButton
   
4. Imports C1.Silverlight.C1MessageBoxIcon
   
5. Imports Newtonsoft.Json
   
6. Imports Newtonsoft.Json.Linq
   
7. Imports Microsoft.VisualBasic
   
8. Imports System.IO
   
9. Imports System.Text
   
10. Imports System.Net
    
11. Imports System.Windows.forms
    
12. Imports System.Threading.Tasks
    
13. 
    
14. Namespace ExcelViewVBDotnet
    
15.    Public Class StandardInterface
    
16.        '预留位置1
    
17.        '预留位置2
    
18.        Dim EV As SpreadsheetGear.Windows.Controls.WorkbookView,AW As SpreadsheetGear.IWorkbook,Range As SpreadsheetGear.IRange
    
19.        Dim PushUrl As String = "http://192.168.0.1:8888/api/WebApi/PushCGRKD"
    
20. 
    
21.        Public Sub Workbook_Open(OldRoot As Object,NewRoot As Object,Excel As SpreadsheetGear.Windows.Controls.WorkbookView)
    
22.            EV = Excel
    
23.            Excel.GetLock()
    
24.            AW = Excel.ActiveWorkbook
    
25.            Range = AW.ActiveWorksheet.Range
    
26.            Excel.ReleaseLock()
    
27.        End Sub'打开时执行事件
    
28. 
    
29.        Public Sub RangeSelection(sender As Object,e As SpreadsheetGear.Windows.Controls.RangeSelectionChangedEventArgs)
    
30. 
    
31.        End Sub'单元格选择后执行的事件
    
32. 
    
33.        Public Sub RangeChanged(sender As Object,e As SpreadsheetGear.Windows.Controls.RangeChangedEventArgs)
    
34. 
    
35.        End Sub'单元格编辑完成后执行事件
    
36. 
    
37.        Public Sub ButtunClick(sender As Object,e As SpreadsheetGear.Windows.Controls.ShapeActionEventArgs)
    
38.             If e.Shape.Name = "发送" Then
    
39.                 Dim payload As String = ""
    
40. 
    
41.                 Try
    
42.                     EV.GetLock()
    
43.                     If EV.RangeSelection Is Nothing OrElse EV.RangeSelection.Cells(0,0).Value Is Nothing Then
    
44.                         EV.ReleaseLock()
    
45.                         C1MessageBox.Show("请选择一个包含JSON字符串的单元格。", "提示", OK, C1MessageBoxIcon.Warning)
    
46.                         Return
    
47.                     End If
    
48. 
    
49.                     payload = EV.RangeSelection.Cells(0,0).Text
    
50.                     EV.ReleaseLock()
    
51.                 Catch ex As Exception
    
52.                     Try
    
53.                         EV.ReleaseLock()
    
54.                     Catch
    
55.                     End Try
    
56.                     C1MessageBox.Show("读取单元格失败：" + ex.Message, "错误", OK, C1MessageBoxIcon.Error)
    
57.                     Return
    
58.                 End Try
    
59. 
    
60.                 If payload Is Nothing OrElse payload.Trim() = "" Then
    
61.                     C1MessageBox.Show("单元格内容为空，请填入要推送的JSON字符串。", "提示", OK, C1MessageBoxIcon.Warning)
    
62.                     Return
    
63.                 End If
    
64. 
    
65.                 Try
    
66.                     JToken.Parse(payload)
    
67.                 Catch ex As Exception
    
68.                     C1MessageBox.Show("JSON格式无效：" + ex.Message, "提示", OK, C1MessageBoxIcon.Warning)
    
69.                     Return
    
70.                 End Try
    
71. 
    
72.                 Dim client As New WebClient()
    
73.                 client.Encoding = Encoding.UTF8
    
74.                 client.Headers("Content-Type") = "application/json; charset=utf-8"
    
75.                 AddHandler client.UploadStringCompleted, AddressOf PushCompleted
    
76. 
    
77.                 Try
    
78.                     client.UploadStringAsync(New Uri(PushUrl, UriKind.Absolute), "POST", payload)
    
79.                 Catch ex As Exception
    
80.                     C1MessageBox.Show("发送失败：" + ex.Message, "错误", OK, C1MessageBoxIcon.Error)
    
81.                 End Try
    
82.             End If
    
83.        End Sub'按钮/标签点击事件
    
84. 
    
85.        Public Sub FollowHyperlink(sender As Object)
    
86. 
    
87.        End Sub '暂不支持
    
88. 
    
89.        Private Sub PushCompleted(sender As Object, e As UploadStringCompletedEventArgs)
    
90.             If e.Error IsNot Nothing Then
    
91.                 C1MessageBox.Show("接口调用失败：" + e.Error.Message, "错误", OK, C1MessageBoxIcon.Error)
    
92.                 Return
    
93.             End If
    
94. 
    
95.             If e.Result Is Nothing OrElse e.Result.Trim() = "" Then
    
96.                 C1MessageBox.Show("接口无返回内容。", "提示", OK, C1MessageBoxIcon.Warning)
    
97.                 Return
    
98.             End If
    
99. 
    
100.             Try
     
101.                 Dim jr As JObject = CType(JsonConvert.DeserializeObject(e.Result), JObject)
     
102.                 Dim msg As String = ""
     
103.                 Dim detailMsg As String = ""
     
104.                 Dim successText As String = ""
     
105. 
     
106.                 If jr.Item("Message") IsNot Nothing Then
     
107.                     msg = jr.Item("Message").ToString()
     
108.                 End If
     
109. 
     
110.                 If jr.Item("Success") IsNot Nothing Then
     
111.                     successText = jr.Item("Success").ToString()
     
112.                 End If
     
113. 
     
114.                 If jr.Item("Details") IsNot Nothing Then
     
115.                     Dim arr As JArray = CType(jr.Item("Details"), JArray)
     
116.                     If arr.Count > 0 Then
     
117.                         Dim item As JObject = CType(arr(0), JObject)
     
118.                         If item.Item("DocNo") IsNot Nothing Then
     
119.                             detailMsg = "单号：" + item.Item("DocNo").ToString()
     
120.                         End If
     
121.                         If item.Item("Message") IsNot Nothing Then
     
122.                             If detailMsg <> "" Then
     
123.                                 detailMsg = detailMsg + vbCrLf
     
124.                             End If
     
125.                             detailMsg = detailMsg + item.Item("Message").ToString()
     
126.                         End If
     
127.                     End If
     
128.                 End If
     
129. 
     
130.                 If successText = "True" OrElse successText = "true" Then
     
131.                     C1MessageBox.Show(msg + vbCrLf + detailMsg, "推送成功", OK, C1MessageBoxIcon.Information)
     
132.                 Else
     
133.                     C1MessageBox.Show(msg + vbCrLf + detailMsg, "推送失败", OK, C1MessageBoxIcon.Warning)
     
134.                 End If
     
135.             Catch ex As Exception
     
136.                 C1MessageBox.Show("返回解析失败：" + ex.Message + vbCrLf + e.Result, "错误", OK, C1MessageBoxIcon.Error)
     
137.             End Try
     
138.        End Sub
     
139. 
     
140.    End Class
     
141. '  注：除事件字眼下可以自定义代码外的所有代码不允许改动，否则编译将有可能失败。
     
142. End Namespace

复制代码