‘‘‘ <summary>
‘‘‘ 功能说明：读取文件内容并设置其中所有的域
‘‘‘ </summary>
‘‘‘ <remarks></remarks>
Function DoFieldFormFile(ByVal strContractGUID As String) As String
Dim strFileGUID As String = MyDB.GetDataItemString("SELECT TOP 1 DocGUID FROM p_Documents WHERE DocType = ‘合同模板‘ and FkGUID=‘" & strContractGUID & "‘")
Dim strReturn As String = "NO"
If Not String.IsNullOrEmpty(strFileGUID) Then
Dim dtDocInfo As DataTable
Dim strFileName As String
Dim strHtTemplateGUID As String
Dim query As CPQuery
‘读取合同模板基础信息
query = "SELECT FkGUID,DocType,DocName,FileName,Location,LastDocGUID,HtTypeCode ".AsCPQuery()
query = query + " FROM p_Documents WHERE DocGUID=" + strFileGUID.AsQueryParameter()
dtDocInfo = query.FillDataTable()
If dtDocInfo.Rows.Count > 0 Then
strFileName = dtDocInfo.Rows(0).Item("Location").ToString() + dtDocInfo.Rows(0).Item("FileName").ToString() ‘文件路径
strHtTemplateGUID = dtDocInfo.Rows(0).Item("LastDocGUID").ToString() ‘文件路径
End If
If Not String.IsNullOrEmpty(strFileName) Then
‘实例化一个word应用程序对象
Dim docMyWord As myWord.Document
Dim appMyWord As myWord.ApplicationClass
Try
appMyWord = New myWord.ApplicationClass
Dim missing As Object = System.Reflection.Missing.Value
‘实例化一个word文档对象
Dim i, intBKCount, j, m As Integer
‘打开一个word对象
strFileName = Server.MapPath(strFileName)
If Dir(strFileName) = "" Then
Throw New Exception(strFileName & "路径下的文件不存在！")
Return "ERROR"
End If
docMyWord = appMyWord.Documents.Open(strFileName, missing, False, missing, missing, missing, missing, missing, missing, missing, missing, False, False, missing, missing, missing)
‘激活
docMyWord.Activate()
‘获取书签数量
intBKCount = docMyWord.FormFields.Count
If intBKCount > 0 Then
Dim strSQL As String = ""
Dim dtMapping, dtContract As DataTable
Dim strMappingFields As String = ""
Dim strTemp, strTemplateName As String
‘循环中用到的临时字段名
Dim strTempFielename As String
‘合同关键信息中编辑的字段
Dim hashGjXx As Hashtable = ContractMNG.GetContractDataHash(strContractGUID)
If hashGjXx.Keys.Count > 0 Then
i = 0
For i = 0 To intBKCount - 1
strTemplateName = docMyWord.FormFields.Item(i + 1).Name
If hashGjXx.Contains(strTemplateName) Then
docMyWord.FormFields.Item(i + 1).Result = hashGjXx.Item(strTemplateName)
docMyWord.FormFields.Item(i + 1).Enabled = False
End If
Next
End If
query = "SELECT TemplateName,ShowName,MappingField,MappingFieldName ".AsCPQuery()
query = query + " FROM cb_HtTemplateMapping WHERE HtTemplateGUID=" + strHtTemplateGUID.AsQueryParameter()
dtMapping = query.FillDataTable()
‘循环对应域的值
If dtMapping.Rows.Count > 0 Then
i = 0
For i = 0 To dtMapping.Rows.Count - 1
strTemp = dtMapping.Rows(i).Item("MappingField").ToString
If strTemp <> "" Then
strMappingFields &= strTemp + ";" ‘读取合同模板和合同表的映射字段（对应合同视图的英文字段名称）
End If
Next
End If
If strMappingFields.Length > 0 Then
strMappingFields = strMappingFields.Substring(0, strMappingFields.Length - 1).Replace(";", ",")
End If
‘循环取得合同表中的值
If strMappingFields <> "" Then
strSQL = "SELECT " & strMappingFields
query = strSQL.AsCPQuery()
query = query + " FROM vcb_contract WHERE ContractGUID =" + strContractGUID.AsQueryParameter()
dtContract = query.FillDataTable()
If dtContract.Rows.Count > 0 Then
i = 0
For i = 0 To intBKCount - 1
strTemplateName = docMyWord.FormFields.Item(i + 1).Name
If dtMapping.Select("TemplateName=‘" & strTemplateName & "‘").Length > 0 Then
strTempFielename = dtMapping.Select("TemplateName=‘" & strTemplateName & "‘")(0).Item("MappingField")
If strTempFielename <> "" Then
docMyWord.FormFields.Item(i + 1).Result = IIf(IsDBNull(dtContract.Rows(0)(strTempFielename)), "", dtContract.Rows(0)(strTempFielename).ToString())
docMyWord.FormFields.Item(i + 1).Enabled = False
End If
End If
Next
End If
End If
‘存储插入的图片
Dim dtPic As DataTable = MyDB.GetDataTable(String.Format("SELECT SUBSTRING(DocName,0 ,LEN(docname) - LEN(RIGHT(DocName, CHARINDEX(‘.‘, REVERSE(DocName)))) + 1) as docname,replace(location,‘\‘,‘\\‘)+FileName as FILENAME FROM dbo.p_Documents WHERE FkGUID = ‘{0}‘ AND DocType = ‘合同图片‘ ORDER BY CreateOn DESC", strContractGUID))
Dim iCount As Integer = dtPic.Rows.Count
Dim bRange As String = ""
Dim sFile As String = ""
For n As Integer = 0 To iCount - 1
bRange = dtPic.Rows(n)("docname").ToString()
sFile = Server.MapPath("/") & dtPic.Rows(n)("FileName").ToString()
InsertPictureAtBookmark(docMyWord, bRange, sFile)
Next
docMyWord.Save()
End If
strReturn = "OK"
Catch ex As Exception
strReturn = "ERROR"
Throw New Exception(ex.Message)
Finally
‘释放资源
If (Not docMyWord Is Nothing) Then
docMyWord.Close(Nothing, Nothing, Nothing)
End If
If (Not appMyWord Is Nothing) Then
appMyWord.Quit(Nothing, Nothing, Nothing)
End If
End Try
End If
End If
Return strReturn
End Function
Private Function InsertPictureAtBookmark(ByVal doc As myWord.Document, ByVal bookmarName As String, ByVal pictureFileName As String)
Dim bks As myWord.Bookmarks = doc.Bookmarks
Dim bookmark As myWord.Bookmark
Dim linkToFile As Boolean = False
Dim saveWithDocument As Boolean = True
bookmark = bks.Item(bookmarName)
If String.Equals(bookmark.Name, bookmarName) Then
‘Dim boolMarkRange As myWord.Range = doc.Range(bookmark.Range.Start, bookmark.Range.End)
bookmark.Range.Delete()
‘For Each inlineShape As myWord.Shape In bookmark.Application.ActiveDocument.InlineShapes
‘ ‘inlineShape.Type
‘ inlineShape.Delete()
‘Next
‘If bookmark.Application.ActiveDocument.InlineShapes.Count > 0 Then
‘ bookmark.Application.ActiveDocument.InlineShapes.Item(1).Delete()
‘End If
‘doc.Application.ActiveDocument.InlineShapes.AddPictureBullet(pictureFileName, bookmark.Range)
doc.Application.ActiveDocument.InlineShapes.AddPicture(pictureFileName, linkToFile, saveWithDocument, bookmark.Range)
End If
End Function
原文：http://www.cnblogs.com/rocket-fds/p/4758017.html