Hello All - In my script below I woud like to create a seperate function that creates a report document contained within the db’s “report” view. I would like the report to include resultgroup.getvalue(1), resultgroup.getvalue(2) and NumSurvey to be displayed for each iteration as a line on the report.
Can anyone point me in the right directiion or froward me a sample?
Much appreciated
Pat
Sub Initialize
Dim con As New ODBCConnection
Dim qry As New ODBCQuery
Dim result As New ODBCResultSet
Dim qryGroup As New ODBCQuery
Dim resultGroup As New ODBCResultSet
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim doc As NotesDocument
Dim NextRecord As Integer
Dim NumSurvey As Integer
Dim RecordCount As Integer
Dim LastRecNum As Integer
Dim Loop1 As Integer
Dim Loop2 As Integer
Dim LoopGroup As Integer
Dim profsession As New NotesSession
Dim profdb As NotesDatabase
Dim profdoc As NotesDocument
Dim XID As Variant
Dim intLeft As Integer
Set profdb = profsession.CurrentDatabase
’ Set the document to the profile form
Set profdoc = profdb.getprofiledocument("DB Profile")
' Set and Get the values of the ODBC User ID and Password
Set RemID = profdoc.GetFirstItem( "RemID")
Set RemPW = profdoc.GetFirstItem( "RemPW")
'Messagebox (RemID.text)
'Messagebox (RemPW.text)
’ Set Date and Time to last 24 hours
Dim dateTime As Variant
dateTime = Now - 1
'Run Query to get data
If con.ConnectTo("RemFeed", RemID.text, RemPW.text) Then
Set qry.Connection = con
Set qryGroup.Connection = con
qryGroup.SQL = "select group_name, Survey_Sampling, Survey_Category from shr_group_vw where Survey_Sampling > 0 and Survey_Group = " & Chr$(34) & "Yes" & Chr$(34)
Set resultGroup.Query = qryGroup
If Not resultGroup.Execute() Then
Messagebox ("Error!" & resultGroup.GetErrorMessage(DB_LASTERROR))
End If
Call ResultGroup.LastRow()
LastRecNumGroup = resultGroup.NumRows
Call resultGroup.FirstRow()
For LoopGroup = 1 To LastRecNumGroup
' Base Filter A : All records not equal to New PC install AND not eqaul to Closed on First Call
qry.SQL = "select HPD_Helpdesk_VW.Name_ , HPD_Helpdesk_VW.State, HPD_Helpdesk_VW.Site, HPD_Helpdesk_VW.Phone_Number, HPD_Helpdesk_VW.Assigned_To_Group_, HPD_Helpdesk_VW.Organization, HPD_Helpdesk_VW.Short_Description, HPD_Helpdesk_VW.Assigned_To_Individual_, HPD_Helpdesk_VW.Division , ArrivalT = dateadd(second, HPD_HelpDesk_VW.Arrival_Time - 14400, "& Chr$(34) & "Jan 1, 1970" & Chr$(34) & "), ResolveT = dateadd(second, HPD_HelpDesk_VW.Resolved_Time - 14400,"& Chr$(34) & "Jan 1, 1970" & Chr$(34) & "), HPD_Helpdesk_VW.Category, HPD_Helpdesk_VW.Type, HPD_Helpdesk_VW.Item, HPD_Helpdesk_VW.Requester_ID_, HPD_Helpdesk_VW.Case_ID_, SHR_PG_and_Secondary_IONS_ID.email from"
qry.SQL = qry.SQL + " HPD_Helpdesk_VW, SHR_PG_and_Secondary_IONS_ID, SH_HPD_Helpdesk where"
qry.SQL = qry.SQL + " HPD_Helpdesk_VW.Case_ID_ = SH_HPD_Helpdesk.Case_ID_ and"
qry.SQL = qry.SQL + " HPD_Helpdesk_VW.Case_Type <> " & Chr$(34) & "Misfire" & Chr$(34) & " AND"
qry.SQL = qry.SQL + " SHR_PG_and_Secondary_IONS_ID.Secondary_IONS_ID = HPD_Helpdesk_VW.Requester_ID_ and"
qry.SQL = qry.SQL + " HPD_Helpdesk_VW.Assigned_To_Group_ = " & Chr$(34) & resultGroup.GetValue(1) & Chr$(34) &" and"
qry.SQL = qry.SQL + " HPD_Helpdesk_VW.status = " & Chr$(34) & "Closed" & Chr$(34) & " And"
qry.SQL = qry.SQL + " HPD_Helpdesk_VW.Status_Description <> " & Chr$(34) & "Resolved First Call" & Chr$(34) & " And"
qry.SQL = qry.SQL + " HPD_Helpdesk_VW.Status_Description <> " & Chr$(34) & "Canceled" & Chr$(34) & " And"
qry.SQL = qry.SQL + " HPD_Helpdesk_VW.Category <> " & Chr$(34) & "INSTALL" & Chr$(34) & " and"
qry.SQL = qry.SQL + " HPD_Helpdesk_VW.Type <> " & Chr$(34) & "HW" & Chr$(34) & " and"
qry.SQL = qry.SQL + " HPD_Helpdesk_VW.Item <> " & Chr$(34) & "WHOLE SYSTEM" & Chr$(34) & " and"
qry.SQL = qry.SQL + " convert(datetime,dateadd(second,SH_HPD_HelpDesk.Closed_Time - 14400," & Chr$(34) & "Jan 1, 1970" & Chr$(34) & ")) >= convert(datetime," & Chr$(34) & dateTime & Chr$(34) & ") and"
qry.SQL = qry.SQL + " HPD_HelpDesk_VW.ID_Mgmt_Request_Number is Null and"
qry.SQL = qry.SQL + " (datediff(dd,convert(datetime,SHR_PG_and_Secondary_IONS_ID.Last_Surveyed), " & Chr$(34) & Now & Chr$(34) & ") > 60 or"
qry.SQL = qry.SQL + " SHR_PG_and_Secondary_IONS_ID.Last_Surveyed is null) and"
qry.SQL = qry.SQL + " SHR_PG_and_Secondary_IONS_ID.email is not null"
'fileNumber% = Freefile
' Open "C:\BPFeedbackTransaction.TXT" For Binary Access Write As fileNumber%
' Put fileNumber%, 1, qry.SQL
'Messagebox (qry.sql)
Set result.Query = qry
If Not result.Execute() Then
Messagebox ("Error!" & result.GetErrorMessage(DB_LASTERROR))
End If
Set db = session.CurrentDatabase
NumSurvey = resultGroup.GetValue(2)
Call Result.LastRow()
LastRecNum = result.NumRows
If LastRecNum <= NumSurvey Then
NumSurvey = LastRecNum
NextRecord = 1
Else
'Here is where we get an evenly distributes sample by dividing the total number of records by how many surveys we need.
NextRecord = Fix(LastRecNum/NumSurvey)
If NextRecord = 0 Then
NextRecord = 1
End If
End If
Call Result.FirstRow()
intLeft = 1
Set view = db.GetView("CFView")
For Loop1 = 1 To NumSurvey
Set doc = New NotesDocument(db)
Doc.Form = "Transaction"
doc.Name = result.GetValue(1)
doc.Phone = result.GetValue(4)
doc.State = result.GetValue(2)
doc.Site = result.GetValue(3)
doc.Organization = result.GetValue(6)
doc.AssigneeGroup = result.GetValue(5)
doc.ShortDescription = result.GetValue(7)
doc.Email = result.GetValue(17)
doc.AssigneeIndividual = result.GetValue(8)
doc.Division = result.GetValue(9)
doc.CreatedDate = result.GetValue(10)
doc.ResolveDate = result.GetValue(11)
doc.Category = result.GetValue(12)
doc.Type = result.GetValue(13)
doc.Item = result.GetValue(14)
doc.IONSID = result.GetValue(15)
doc.TicketNumber = result.GetValue(16)
doc.Survey_Category = resultGroup.GetValue(3)
doc.keysent = "1"
doc.qry = QryRan
Call doc.Save(True, False)
' After any error-generating statement, resume
’ execution with the next statement.
On Error Resume Next
'Here is where we will send the survey
%REM
Dim newDoc As NotesDocument
Dim rtitem As NotesRichTextItem
Set db = session.CurrentDatabase
Set newDoc = New NotesDocument( db )
Set rtitemA = profdoc.GetFirstItem( "ProfMailto")
Set rtitemB = profdoc.GetFirstItem( "ProfSelfHelpLink")
Set rtitem = New NotesRichTextItem( newDoc, "Body" )
newDoc.Principal = "Corporate Technology Management"
newDoc.Form = "Memo"
newDoc.SendTo = doc.email
If result.GetValue(6)="PSI" Then
newDoc.Principal = "Information Systems Group"
newDoc.Subject = "ISG Satisfaction Feedback"
Call rtitem.AppendText( "ISG is committed to providing world class support. Your opinion is very important. " & Chr(13) )
Call rtitem.AppendText( Chr(13) & "In order for our support analysts to improve the quality of services delivered to you, we are" )
Call rtitem.AppendText( Chr(13) & " asking that you please complete and return this feedback form." & Chr(13) )
Call rtitem.AppendText( Chr(13) & "Your immediate feedback will help us to gauge how well we have satisfied your needs and ")
Call rtitem.AppendText( Chr(13) & " to determine how we can better serve you in the future." & Chr(13) )
Call rtitem.AppendText( Chr(13) & "Thank you for taking the time to provide us with your feedback. We may contact you as part")
Call rtitem.AppendText( Chr(13) & " of our follow up process in order to implement improvements to our service delivery." & Chr(13) )
Call rtitem.AppendText( Chr(13) & "The information below briefly describes your closed Remedy ticket:" & Chr(13) )
Call rtitem.AppendText( Chr(13) &"Ticket #" & doc.TicketNumber(0) & " stating " & Chr(34) & doc.ShortDescription(0) & Chr(34) & Chr(13) )
Call rtitem.AppendText( Chr(13) &"Please click here to access your feedback form" & " =====> " )
Call rtitem.AppendDocLink( doc,"ISG Customer Satisfaction Feedback")
Call newDoc.Send( False )
End If
If result.GetValue(6)<>"PSI" Then
newDoc.Principal = "Corporate Technology Management"
newDoc.Subject = "CTM Satisfaction Feedback"
Call rtitem.AppendText( "CTM is committed to providing world class support. Your opinion is very important. " & Chr(13) )
Call rtitem.AppendText( Chr(13) & "In order for our support analysts to improve the quality of services delivered to you, we are" )
Call rtitem.AppendText( Chr(13) & "asking that you please complete and return this feedback form. Your immediate response" )
Call rtitem.AppendText( Chr(13) & "will help us to gauge how well we have satisfied your needs and to determine how we can" )
Call rtitem.AppendText( Chr(13) & "better serve you in the future." & Chr(13) )
Call rtitem.AppendText( Chr(13) & "Thank you for taking the time to provide us with your feedback. We may contact you as part" )
Call rtitem.AppendText( Chr(13) & " of our follow up process in order to implement improvements to our service delivery." )
Call rtitem.AppendText( Chr(13) & "The information below briefly describes your closed Remedy ticket:" & Chr(13) )
Call rtitem.AppendText( Chr(13) &"Ticket #" & doc.TicketNumber(0) & " stating " & Chr(34) & doc.ShortDescription(0) & Chr(34) & Chr(13) )
Call rtitem.AppendText( Chr(13) &"Please click here to access your feedback form" & " =====> " )
Call rtitem.AppendDocLink( doc,"CTM Customer Satisfaction Feedback" & Chr(13) )
Call rtitem.AddNewLine( 1 )
Call rtitem.AppendText( Chr(13) & "Please direct questions/problems regarding the form only (not service feedback) to: ")
Call rtitem.AppendRTItem( rtitemA )
Call rtitem.AddNewLine( 1 )
Call rtitem.AppendText( Chr(13) & "***************************** DID YOU KNOW... CTM HAS A NEW WEB SITE! *****************************" )
Call rtitem.AppendText( Chr(13) & "You can find the solutions to many of your computer related issues and reset your LAN Password" )
Call rtitem.AppendText( Chr(13) & "by simply typing ")
Call rtitem.AppendRTItem( rtitemB )
Call rtitem.AppendText( " in your Internet Explorer Browser. From the CTMHELP" )
Call rtitem.AppendText( Chr(13) & "web site you can also reset your Mainframe and RACF passwords by simply answering a few ")
Call rtitem.AppendText( Chr(13) & "short questions. Current System Statuses are displayed right on the CTMHELP Page." & Chr(13))
Call rtitem.AppendText( Chr(13) & "Passwords can also be reset by using our automated phone system by calling 888-778-7789 and" )
Call rtitem.AppendText( Chr(13) & "choosing Option 1 for Password Resets. " )
Call newDoc.Send( False )
End If
%END REM
For Loop2 = 1To nextrecord
Call result.Nextrow()
Next Loop2
Next Loop1
resultGroup.NextRow
Next LoopGroup
Else
Messagebox("Could not connect to server")
End If
Status = con.Disconnect
'Msgbox(status)
End Sub