First Import NameSpace
******************************************
Imports Microsoft.Office.Interop.Word
Imports Microsoft.Office.Interop
*******************************************
Public Sub createlog()
Dim comtype1 As String
Dim wrd As Word.Application
Dim Doc As Word.Document
wrd = CreateObject("Word.Application") 'Create Object
Doc = wrd.Documents.Add()
comtype1 = "-----BASIC COMPLAINT DETAILS-----"
Dim strconnection As String = ConfigurationManager.ConnectionStrings("MyDb").ConnectionString
cn = New SqlConnection(strconnection)
da = New SqlDataAdapter("select * from call_description order by s_id desc", cn)
ds = New DataSet
da.Fill(ds)
If ds.Tables(0).Rows.Count - 1 Then
With Doc.Application
.Selection.Font.Size = "10"
.Selection.Font.Name = "Verdana"
.Selection.Font.Color = &H4696F7 'Orange Color
.Selection.Font.Bold = True
.Selection.TypeText(Text:=comtype1 & vbCrLf)
.Selection.ParagraphFormat.Alignment = WdParagraphAlignment.wdAlignParagraphJustify
.Selection.Font.Bold = False
.Selection.Font.Color = WdColor.wdColorBlack
.Selection.TypeText(Text:="COMPLAINT REGISTERED THROUGH PHONE " & vbCrLf)
.Selection.TypeText(Text:="SERIOUSNESS OF COMPLAINT: " & vbCrLf)
.Selection.TypeText(Text:=ds.Tables(0).Rows(0).Item("call_type") & vbCrLf)
.Selection.TypeText(Text:="COMPLAINT DATE: ")
.Selection.TypeText(Text:=ds.Tables(0).Rows(0).Item("date_time") & vbCrLf)
.Selection.TypeText(Text:="NAME OF VICTIM: ")
.Selection.TypeText(Text:=ds.Tables(0).Rows(0).Item("VICTIM_NAME") & vbCrLf)
.Selection.TypeText(Text:="STATE: ")
.Selection.TypeText(Text:=ds.Tables(0).Rows(0).Item("State") & vbCrLf)
.Selection.TypeText(Text:="COMPLAINT DETAILS: " & vbCrLf)
.Selection.TypeText(Text:=Trim(removeextras(CStr(ds.Tables(0).Rows(0).Item("Call_descrip")), vbCrLf)))
End With
wrd.ActiveDocument.Protect(WdProtectionType.wdAllowOnlyFormFields, , "admin")
wrd.ActiveDocument.SaveAs("C:\Documents and Settings\CLIENT4\My Documents\word\Log.doc")
wrd.ActiveDocument.Close()
wrd.Quit()
' Doc = Nothing
' wrd = Nothing
End If
End Sub
**************************
Function removeextras(ByVal sstring As String, ByVal delim As String) As String
While (sstring Like "*" & delim & delim & "*")
sstring = Replace(sstring, delim & delim, delim)
End While
removeextras = sstring
End Function