office插件详细文档

OFFICE插件详细文档
一、上传组件(officeUpload)
该组件主要用于上传word、excel文件。

组件主要文件如下：
1.文件头Upload.h
2.源文件Upload.cpp
3.外接口Upload.def
Upload.cpp 相关函数作用介绍：
STDAPI DllRegisterServer(void)：用于Regsvr32注册该dll
CString ConvertGBKToUtf8(CString& strGBK) ：将文件中文名转成utf-8的方式，防止中文乱码。

CString MakeRequestHeaders(CString &strBoundary)：封装发送文件的包头。

CString MakePreFileData(CString &strBoundary, CString &strFileName, int iRecordID)：封装要发送文件的相关信息。

extern "C" __declspec(dllexport) void __stdcall SendTrack(char* filePath,char* serverIp,int serverPort,char* loginAction,char* uploadAction,char* attachAction)：
该函数被定义成外露接口，是被VB调用的上传文件的函数。

（1）能被VB调用的外露接口定义如下：
A、函数名前要被extern "C" __declspec(dllexport)修饰，表明这是个外露接口。

返回值后被__stdcall修饰，表面这个外露接口能被VB调用。

格式如下：
extern "C" __declspec(dllexport) 返回值__stdcall 函数名(参数)
B、导出外露接口：
在Upload.def中定义要导出的外露接口：
格式如下：
LIBRARY "Upload"
EXPORTS
DllRegisterServer PRIV ATE
SendTrack
（2）外露函数相关代码段介绍：
CInternetSession类获取访问某个URL的session，通过session获取http连接的指针（CHttpConnection）对象。

打开请求和设置文件头，最后发送请求。

使用方法如下：pHttpConnection = Session.GetHttpConnection(defServerName,nPort);//获取连接
Session.OpenURL(_T("http://"+defServerName+":"+strPort+defLoginURL));//登录服务器Sleep(1000);//延迟1秒
pHTTP = pHttpConnection->OpenRequest(CHttpConnection::HTTP_VERB_POST, defUploadName);//打开上传文件的请求连接。

pHTTP->AddRequestHeaders(MakeRequestHeaders(strHTTPBoundary));//发送包头请求pHTTP->SendRequestEx(dwTotalRequestLength, HSR_SYNC | HSR_INITIATE);//发送需要接收内容的长度。

MessageBox消息提示框语法如下：
::MessageBox(NULL,"上传失败，file not find！","友情提示",MB_ICONEXCLAMATION); 消息框前必须用::修饰。

第二个参数是提示内容，第三个参数表示标题，第四个参数表示消息框类型，如警告提示框。

接收HTTP响应返回值代码段如下：
while (0 != dwResponseLength)
{
szResponse = (LPSTR)malloc(dwResponseLength + 1);
szResponse[dwResponseLength] = '\0';
pHTTP->Read(szResponse, dwResponseLength);
strResponse += szResponse;
free(szResponse);
dwResponseLength = pHTTP->GetLength();
}
strResponse为服务端返回的信息。

将返回值左右截取空格，方法如下：
strResponse.TrimRight();
strResponse.TrimLeft();
截取返回值中必要信息，方法取下：
strResponse.Mid(10,strResponse.GetLength()-11)（此处截取到的是附件返回的编码）指定用IE打开URL:
ShellExecute(NULL,NULL,
"iexplore",defAttachName+"%26attachid%3D"+strResponse.Mid(10,strResponse.GetLength( )-11), NULL, SW_SHOW);
二、Word组件(WordAddin)
1.设计器
相关参数选择如下：
2.添加OFFICE菜单模块
首先点击工程->引用->选择microsoft Word 12.0 Object Library,如下所示：
'声明变量、类实例和集合
Public xlApp As Word.Application ---申明word应用对象
Dim ButtonEvent As cbEvents --- cbEvents该类是自定义类，封装了按钮事件
Dim ButtonEvents As Collection
'定义自已菜单的子程序
Public Sub CreateToolbarButtons()
'声明变量
Dim cbBar As mandBar
Dim btNew As mandBarButton
On Error Resume Next
RemoveToolbarButtons ---每次启动时，删除原来菜单项
//新建菜单项如下
Set MyBar = mandBars("Menu Bar") //定义菜单条
MyBar.Visible = True
Set btNew = MyBar.Controls.Add(Type:=msoControlButton, Temporary:=True) --定义菜单按钮
Set oPic = LoadPicture(App.Path & "\logo.bmp")
With btNew
.Caption = "转发协同" -------定义按钮名称
.Style = msoButtonIconAndCaption ----定义按钮样式
.Tag = "WordAddin"---按钮标记
.OnAction = "openFrame" ---点击按钮时，要调用的方法名称
.FaceId = 13 ----定义按钮图标
.Visible = True ----定义按钮可见
End With
----------给按钮绑定点击事件
'获取cbevents类中的一个新实例
Set ButtonEvent = New cbEvents
'将它指定给我们所创建的按钮
Set ButtonEvent.cbBtn = btNew
ButtonEvents.Add ButtonEvent
End Sub
'删除自已定义的菜单的子程序
Public Sub RemoveToolbarButtons()
Dim cbBar As CommandBar
Dim cbCtr As CommandBarControl
'忽略错误
On Error Resume Next
'需要从命令条中移除按钮
'首先找到该按钮
Set cbBar = mandBars("Menu Bar")
'运用我们所设置的标签查找控件
Set cbCtr = cbBar.Controls("转发协同")
If Not cbCtr Is Nothing Then
'删除
cbCtr.Delete
Set cbCtr = cbBar.Controls("转发协同")
End If
'恢复占用的内存
Set ButtonEvents = Nothing
Set ButtonEvent = Nothing
End Sub
'示例子过程
Sub openFrame(ByVal urlParam As String)
Form1.setParam (urlParam) ---setParam自定义函数，用于接收传来的值
Form1.Show ----显示FORM
End Sub
3.菜单按钮事件模块
该模块需引用控件xmlhttp，引用Microsoft XML6.0方法如下：
Private Sub cbBtn_Click(ByVal Ctrl As mandBarButton, CancelDefault As Boolean)
'忽略产生的任何错误
Dim w As Object
Dim filePath As String
Dim serverUrl As String
----------判断当前文件是否保存
If xlApp.Application.ActiveDocument.Saved Then
Set w = CreateObject("wscript.shell")
----读取注册表，找到平台精灵的安装目录
filePath = w.RegRead("HKEY_CLASSES_ROOT\MSGCLIENT\URL Protocol") filePath = Left(filePath, InStrRev(filePath, "\"))
---读取ini配置文件特定键对应的值
serverUrl = GetIniStr(filePath + "system.ini", "power", "msg_server_url")
On Error Resume Next
----判断平台精灵目录下是否存在temp.txt文件
If Dir(filePath + "temp.txt") = "" Then
MsgBox "请先登录平台精灵！", 48, "友情提示", "help.hlp", 1000
Shell filePath + "MsgClient.exe" ------打开平台精灵
Else
' Set XMLObject = CreateObject("MSXML2.XMLHTTP")
' If Not IsObject(XMLHTTP) Then
' Set XMLObject = CreateObject("Microsoft.XMLHTTP")
' End If
' If Not IsObject(XMLHTTP) Then
' MsgBox "无法创建xmlHttp对象！"
' End If
Dim SendStr As String
Dim XMLObject As XMLHTTP
Dim ReturnText As String, ReturnByte() As Byte
Dim thetimeout As Long
----------创建xmlhttp对象
Set XMLObject = CreateObject("Microsoft.XMLHTTP")
SendStr = GetFile(filePath + "temp.txt")-----读取要发送的temp.txt信息
thetimeout = GetTickCount()---获取当前事件毫秒
---------post发送URL
XMLObject.Open "POST", serverUrl + "msgDispath?method=checkOnline", False
--------设置请求包头
XMLObject.setRequestHeader "Referer", serverUrl + "msgDispath?method=checkOnline"
XMLObject.setRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded"
XMLObject.setRequestHeader "CONTENT-LENGTH", Len(SendStr)
XMLObject.send SendStr ---------发送信息
Do
If XMLObject.ReadyState = 4 Then
If XMLObject.Status = 200 Then
ReturnByte = XMLObject.responseBody 接收返回值
ReturnText = StrConv(ReturnByte, vbUnicode) 将返回值转成字符串Else
ReturnText = "error"
End If
Exit Do
End If
If GetTickCount() - thetimeout > 1000 Then ----超时处理
ReturnText = "timeout"
Exit Do
End If
DoEvents
Loop
If ReturnText <> "" Then
Select Case Ctrl.OnAction ---根据点击事件的action名称，选择执行相应的函数
Case "openFrame"
openFrame (ReturnText)
End Select
Else
MsgBox "请重新登录平台精灵！", 48, "友情提示", "help.hlp", 1000
Shell filePath + "MsgClient.exe"
'查找指定给OnAction属性的程序删除Excel
End If
End If
Else
MsgBox "请先保存当前文档！", 48, "友情提示", "help.hlp", 1000 End If
CancelDefault = True
End Sub
Function GetFile(FileName As String) As String
Dim FileContents() As Byte, FileNumber As Integer
ReDim FileContents(FileLen(FileName) - 1)
FileNumber = FreeFile
Open FileName For Binary As FileNumber
Get FileNumber, , FileContents
Close FileNumber
GetFile = StrConv(FileContents, vbUnicode)
End Function
4.读取配置ini文件的公用方法模块
Option Explicit
Private Declare Function GetPrivateProfileString Lib "KERNEL32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal pFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "KERNEL32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileSection Lib "KERNEL32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
'*************************************
'目的:写入数据至Ini文件
'输入: FileName 文件名
' AppName 项目名
' In_Key 键名
' In_Data 键名上的数值
'返回: 写入成功True
' 写入失败False
'*************************************
Public Function WriteIniStr(ByVal FileName As String, ByVal AppName As String, ByVal In_Key As String, ByVal In_Data As String) As Boolean
On Error GoTo WriteIniStrErr
WriteIniStr = True
If VBA.Trim(In_Data) = "" Or VBA.Trim(In_Key) = "" Or VBA.Trim(AppName) = "" Then GoTo WriteIniStrErr
Else
WritePrivateProfileString AppName, In_Key, In_Data, FileName
End If
Exit Function
WriteIniStrErr:
Err.Clear
WriteIniStr = False
End Function
'*************************************
'目的:从Ini文件中读取数据
'输入: FileName 文件名
' AppName 项目名
' In_Key 键名
'返回: 取得给定键名上的数据
'*************************************
Public Function GetIniStr(ByVal FileName As String, ByVal AppName As String, ByVal In_Key As String) As String
On Error GoTo GetIniStrErr
If VBA.Trim(In_Key) = "" Then
GoTo GetIniStrErr
End If
Dim GetStr As String
GetStr = VBA.String(128, 0)
GetPrivateProfileString AppName, In_Key, "", GetStr, 256, FileName
GetStr = VBA.Replace(GetStr, VBA.Chr(0), "")
If GetStr = "" Then
GoTo GetIniStrErr
Else
GetIniStr = GetStr
GetStr = ""
End If
Exit Function
GetIniStrErr:
Err.Clear
GetIniStr = ""
GetStr = ""
End Function
'Option Explicit
'遍历ini文件, 某个主键下的所有Key
Public Function GetInfoSection(strSection As String, strIniFile As String) As String() Dim strReturn As String * 32767
Dim strTmp As String
Dim nStart As Integer
Dim nEnd As Integer
Dim i As Integer
Dim sArray() As String
Call GetPrivateProfileSection(strSection, strReturn, Len(strReturn), strIniFile)
strTmp = strReturn
i = 1
Do While strTmp <> ""
nStart = nEnd + 1
nEnd = InStr(nStart, strReturn, vbNullChar)
strTmp = Mid$(strReturn, nStart, nEnd - nStart)
If Len(strTmp) > 0 Then
ReDim Preserve sArray(1 To i)
sArray(i) = strTmp
i = i + 1
End If
Loop
GetInfoSection = sArray
End Function
5.发送文件模块
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
---------此处定义要引用的dll，注：此dll通常放在system32下（64位放在SysWOW64文件夹下，函数参数需与VC中函数参数一致，函数名也需一致）；
Private Declare Function SendTrack Lib "Upload.dll" (ByVal filePath As String, ByVal serverIp As String, ByVal serverPort As Integer, ByVal loginAction As String, ByVal uploadAction As String, ByVal attachAction As String) As String
Dim urlParam As String
Dim mx As Single
Dim my As Single
Private Sub Command1_Click()
Dim fs As New FileSystemObject
Dim tempPath As String
Dim uploadPath As String
Dim loginUrl As String
Dim uploadUrl As String
Dim attachUrl As String
Dim checkLoginUrl As String
Dim serverIp As String
Dim serverPort As String
Dim filePath As String
'Dim attachid As String
Dim user As String
----判断office文件是否有保存
If Not xlApp.Application.ActiveDocument.Saved Then
MsgBox "请先保存当前文档！", 0, "友情提示", "help.hlp", 1000
Else
Command1.Enabled = False ----使按钮失效
tempPath = getInstallPath
tempPath = tempPath + "temp"
---判断目录是否存在
If Dir(tempPath, vbDirectory) = "" Then
MkDir tempPath ----创建目录
End If
-----构造新的路径文件
uploadPath = tempPath + "\" +
-----将当前要发送的文档复制到构造的文件路径
----- 表示word文档名称
----- xlApp.Application.ActiveDocument.FullName表示word文档的全路径名
fs.CopyFile xlApp.Application.ActiveDocument.FullName, uploadPath
filePath = getInstallPath
serverIp = GetIniStr(filePath + "system.ini", "power", "server_ip")
serverPort = GetIniStr(filePath + "system.ini", "power", "server_port")
loginUrl = GetIniStr(filePath + "system.ini", "power", "login_url")
uploadUrl = GetIniStr(filePath + "system.ini", "power", "upload_url")
checkLoginUrl = GetIniStr(filePath + "system.ini", "power", "check_login_url")
attachUrl = GetIniStr(filePath + "system.ini", "power", "attach_url")
user = Mid(urlParam, 8, InStr(urlParam, "&") - 8) ------截取checkOnline返回的响应值从而获得当前正在上传文件的用户名；
attachUrl = "http://" + serverIp + ":" + serverPort + checkLoginUrl + "?oaCode=" + user + "&url=" + URLEncode(attachUrl)
'attachUrl = "http://" + serverIp + ":" + serverPort + attachUrl + "&oaCode=" + user
On Error Resume Next
SendTrack uploadPath, serverIp, CInt(serverPort), loginUrl + "?" + urlParam, uploadUrl + "&oaCode=" + user, attachUrl -------------调用自定义VC接口发送文件
If Err.Number <> 0 Then ---------如果发生运行时错误，将提示发送失败
MsgBox "文件上传失败！", 48, "友情提示", "help.hlp", 1000
Unload Form1
Exit Sub
End If
If Dir(uploadPath) <> "" Then ---------删除复制的临时文件
Kill uploadPath
End If
Unload Form1 ----退出FORM
End If
End Sub
Sub setParam(param As String)
urlParam = param
End Sub
Sub IEOpen(URL As String)
'Create InternetExplorer
Dim WebBrowser: Set WebBrowser = CreateObject("InternetExplorer.Application")
WebBrowser.Visible = True
'WebBrowser.AddressBar = False
WebBrowser.Navigate2 URL
End Sub
-------------将URL encode编码
Function URLEncode(strURL)
Dim i
Dim tempStr
For i = 1 To Len(strURL)
If Asc(Mid(strURL, i, 1)) < 0 Then
tempStr = "%" & Right(CStr(Hex(Asc(Mid(strURL, i, 1)))), 2)
tempStr = "%" & Left(CStr(Hex(Asc(Mid(strURL, i, 1)))), Len(CStr(Hex(Asc(Mid(strURL, i, 1))))) - 2) & tempStr
URLEncode = URLEncode & tempStr
ElseIf (Asc(Mid(strURL, i, 1)) >= 65 And Asc(Mid(strURL, i, 1)) <= 90) Or (Asc(Mid(strURL, i, 1)) >= 97 And Asc(Mid(strURL, i, 1)) <= 122) Or (Asc(Mid(strURL, i, 1)) >= 48 And Asc(Mid(strURL, i, 1)) <= 57) Then
URLEncode = URLEncode & Mid(strURL, i, 1)
Else
URLEncode = URLEncode & "%" & Hex(Asc(Mid(strURL, i, 1))) End If
Next
End Function
'read binary file As a string value
---------读取文件内容
Function GetFile(FileName As String) As String
Dim FileContents() As Byte, FileNumber As Integer
ReDim FileContents(FileLen(FileName) - 1)
FileNumber = FreeFile
Open FileName For Binary As FileNumber
Get FileNumber, , FileContents
Close FileNumber
GetFile = StrConv(FileContents, vbUnicode)
End Function
'******************* upload - end
-------读取平台精灵安装路径
Function getInstallPath() As String
Dim w As Object
Dim installPath As String
Set w = CreateObject("wscript.shell")
installPath = w.RegRead("HKEY_CLASSES_ROOT\MSGCLIENT\URL Protocol") installPath = Left(installPath, InStrRev(installPath, "\"))
getInstallPath = installPath
End Function
---------卸载FORM
Private Sub Image1_Click()
Unload Form1
End Sub
----最小化FORM
Private Sub Image2_Click()
Form1.WindowState = 1
End Sub
-----------以下两个函数可以使得FORM能够拖动。

因为弹出的FORM的属性，此时的FORM是不可以
自动拖动的，需借助下面两个函数来实现FORM的拖动。

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single) mx = x
my = Y
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single) If Button <> 1 Then Exit Sub
On Error Resume Next
Form1.Left = Form1.Left + x - mx
Form1.Top = Form1.Top + Y - my
End Sub
三、Excel组件(ExcelAddin)
ExcelAddin与WordAddin开发大致相同，主要区别如下：
1、设计器配置如下：
2.创建菜单的区别：
'声明变量、类实例和集合
Public xlApp As Excel.Application
----Excel应用定义为Excel.Application，Word定义为：Word.Application
Excel要引用的控件如下：
Excel创建菜单栏：Set MyBar = mandBars("Worksheet Menu Bar")
Word创建菜单栏：Set MyBar = mandBars("Menu Bar")
Excel判断文件是否保存：xlApp.Application.ActiveWorkbook.Saved (返回值true/false) Word判断文件是否保存：xlApp.Application.ActiveDocument.Saved (返回值true/false)
Excel获取文件名及全路径名
CopyFile xlApp.Application.ActiveWorkbook.FullName
Word获取文件名及全路径名
xlApp.Application.ActiveDocument.FullName
四、其他操作介绍
1、生成dll
单击文件—>生成xxx.dll
2、新建工程
选择“外接程序”。

即可开发外接程序。

3、窗口控件主要属性配置
背景颜色：
窗口显示样式：
背景图片：
屏幕中心显示：
按钮失效图片和按下图片设置如下：
背景图片
4、项目引用部件支持
项目->部件。