Code won't run from subform

[PortyAL]

Hi

I have a form "frm Recs Tracked Jobs" in which there is a subform "tbl Additional Files subform" in datasheet format. I wish to run a routine (see below) to create an e-mail using info in the chosen record in the subform by clicking on a field in the subform.

 Private Sub Miscemail()

On Error GoTo nofiles

Dim appOutlook As Outlook.Application
Dim ItmNewEmail As Outlook.MailItem
Dim TemplateName As String
Dim strBody As String
Dim attname As String
Dim attnameAP As String

DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 'save record before proceeding

TemplateName = "i:\ia manual\e-mail templates\drtemp1.oft"
attname = Forms![frm recs tracked jobs]![tbl additional files subform]![FullName]

Set appOutlook = New Outlook.Application
Rem Set ItmNewEmail = appOutlook.CreateItem(olMailItem)
Set ItmNewEmail = appOutlook.CreateItemFromTemplate(TemplateName)

strBody = strBody & Chr(13) & Chr(10)
strBody = strBody & Forms![frm recs tracked jobs]![HOSFirstName] & Chr(13) & Chr(13)
strBody = strBody & "Regards"

With ItmNewEmail
     .To = Forms("frm recs tracked jobs").Controls("empname").Value
     .CC = Forms("frm recs tracked jobs").Controls("Contact").Value & ";Brona Slevin"
     .Subject = Forms("frm recs tracked jobs").Controls("job").Value & " IA Inspection - Final Report"
     .Body = strBody
    .BodyFormat = olFormatHTML
    .Attachments.Add attname
    Rem .Attachments.Add attnameAP
    .ReadReceiptRequested = True
    .Display
    
End With

exit_01:
Exit Sub

nofiles:
MsgBox "Final Report and/or Signed Action Plan is not present", vbInformation, "Cannot create e-mail"
GoTo exit_01

End Sub

When I assign this code to the "Click" event on the field in the subform, I get the following error message when I try to run it:

"A problem occured while Microsoft Access was communicating with the OLE server or ActiveX Control. Close the OLE server and restart it outside of Microsoft Access. Then try the original operation again in Microsoft Access."

The code does work if I run it manually from the VBA Module window after choosing the relevant record in the subform.

Any advice would be greatly appreciated.

Thanks

AL

 

[TheAceMan1]

How are ya PortyAL . . .

Hard to say why you got an error relating to [blue]ActiveX[/blue] but I do see the following error by eye:

[blue]attname = Forms![frm recs tracked jobs]![tbl additional files subform]![FullName]
   [green]should be:[/green]
attname = Forms![frm recs tracked jobs]![tbl additional files subform][purple][b].Form[/b][/purple]![FullName][/blue]

In any case I'ce cleaned up the code. backup your origional and try the following:

[blue]Private Sub MiscEmail()
   Dim ol As Outlook.Application, NewEmail As Outlook.MailItem
   Dim tmpFile As String, Body As Stringatt, Name As String
   Dim frm As Form, sfrm As Form, NL As String, DL As String
   Dim Msg As String, Style As Integer, Title As String

On Error GoTo GotErr
   Set frm = Forms![frm recs tracked jobs]
   Set sfrm = frm![tbl additional files subform][purple][b].Form[/b][/purple]
   NL = vbNewLine
   DL = NL & NL

   DoCmd.RunCommand acCmdSaveRecord 'save record before proceeding
   tmpFile = "i:\ia manual\e-mail templates\drtemp1.oft"
   attName = sfrm!FullName
   
   Set ol = New Outlook.Application
   Set NewEmail = ol.CreateItemFromTemplate(tmpFile)
   Body = NL & frm!HOSFirstName & DL & "Regards"
   
   With NewEmail
      .To = frm!empname
      .CC = frm!Contact & ";Brona Slevin"
      .Subject = frm!job & " IA Inspection - Final Report"
      .Body = Body
      .BodyFormat = olFormatHTML
      .Attachments.Add attName
      .ReadReceiptRequested = True
      .Display
   End With
   
SeeYa:
   Set NewEmail = Nothing
   Set ol = Nothing
   Set sfrm = Nothing
   Set frm = Nothing
   Exit Sub
   
GotErr:
   Msg = "Final Report and/or Signed Action Plan is not present"
   Style = vbInformation + vbOKOnly
   Title = "Can't Create Email! . . ."
   MsgBox Msg, Style, Title
   Resume SeeYa

End Sub[/blue]

See Ya! . . . . . .

Be sure to see FAQ219-2884: