Modifying SendObject to work with Groupwise basGWdemo

[kaatjev]

I have two working scripts that I need to somehow combine...

Global vOfficeID As String
Function OfficeID()
   OfficeID = vOfficeID
End Function

is in a module, and together with this form script

Private Sub Command0_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim recCount As Long
Set db = CurrentDb
Set rs = db.OpenRecordset("NH CLIENTS", dbOpenDynaset)
rs.MoveFirst
Do
   vOfficeID = rs("CLIENT NUMBER")
   recCount = DCount("[ACCESSION]", "Query1")
   If recCount > 0 Then
      DoCmd.SendObject acSendReport, "ReportName", acFormatRTF, rs("E-MAIL ADDRESS"), "", "", "Daily Census Report", "", False
   End If
   rs.MoveNext
Loop Until rs.EOF
rs.Close

db.Close
End Sub

sends Access reports to the individual clients.
It used to work nicely with GroupWise until an autoupdate of some kind made Access look for Outlook or some other MS product. I need to force Access to look for GroupWise and found the script below along with the GW class module through this forum at

http://www.mvps.org/access/modules/mdl0059.htm

Sub RunDemo()
'this is a sample usage routine
On Error GoTo Err_Handler
Dim strTemp As String
Dim varAttach(1) As Variant
Dim strRecTo(1, 0) As String
Dim lngCount As Long
Dim varProxies As Variant
Dim cGW As GW

varAttach(0) = "c:\command.com"
varAttach(1) = "P:\Census Processor\samplefaxfile.txt"

strRecTo(0, 0) = "email@email.com"
strRecTo(1, 0) = "Full Name 1"

Set cGW = New GW
With cGW
  .Login
  .BodyText = "Please complete the attached form and fax back to 123-1234."
  .Subject = "Daily Census Report"
  .RecTo = strRecTo
  .FileAttachments = varAttach
  .FromText = "FromText"
  .Priority = "Normal"
  strTemp = .CreateMessage
  .ResolveRecipients strTemp
  If IsArray(.NonResolved) Then MsgBox "Some unresolved recipients."
  .SendMessage strTemp
  .DeleteMessage strTemp, True
End With

Exit_Here:
  Set cGW = Nothing
  Exit Sub

Err_Handler:
  MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
  Resume Exit_Here

End Sub

The above code is in a module.
The attachment for the e-mail should be the Report generated by the individualized script.


How do I make these two codes work together? Where I can have someone press a button (on a form) to send the reports to the individual clients?

 

[kaatjev]

Never mind... made it work

Here is what I came up with.

Private Sub Command0_Click()

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim recCount As Long
Dim recipient As String
Dim recipsubject As String
Set db = CurrentDb
Set rs = db.OpenRecordset("NH CLIENTS", dbOpenDynaset)
rs.MoveFirst
Do
   vOfficeID = rs("CLIENT NUMBER")
   recipient = rs("E-MAIL ADDRESS")
   recipsubject = "NH " & rs("CLIENT NUMBER") & " - " & rs("FAX NUMBER")
   recCount = DCount("[ACCESSION]", "Query1")
   If recCount > 0 Then
      DoCmd.OutputTo acOutputReport, "ABC", acFormatRTF, "P:\Census Processor\ABC.rtf", False
            
      On Error GoTo Err_Handler
Dim strTemp As String
Dim varAttach(1) As Variant
Dim strRecTo(1, 0) As String
Dim lngCount As Long
Dim varProxies As Variant
Dim cGW As GW

varAttach(0) = "c:\command.com"
varAttach(1) = "P:\Census Processor\ABC.rtf"

strRecTo(0, 0) = recipient
strRecTo(1, 0) = recipsubject

Set cGW = New GW
With cGW
  .Login
  .BodyText = "Please complete the attached form and fax back to 123-123-1234."
  .Subject = "Daily Census Report"
  .RecTo = strRecTo
  .FileAttachments = varAttach
  .FromText = "FromText"
  .Priority = "Normal"
  strTemp = .CreateMessage
  .ResolveRecipients strTemp
  If IsArray(.NonResolved) Then MsgBox "Some unresolved recipients."
  .SendMessage strTemp
  .DeleteMessage strTemp, True
End With

   
      
      Kill "P:\Census Processor\ABC.rtf"
    End If
   rs.MoveNext
Loop Until rs.EOF
rs.Close

db.Close

Exit_Here:
  Set cGW = Nothing
  Exit Sub

Err_Handler:
  MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
  Resume Exit_Here


End Sub