Don Elliker
delliker at hotmail.com
Fri Aug 8 10:35:30 CDT 2003
OK- maybe I didn't put enough code in the last try at this question, so here is everyting except the dimensioning. This fails when I try to use '.Action = acOLECreateLink' I get error 2771- "The bound or unbound object frame you tried to edit doesn't contain an OLE object." Does Anybody have any idea why??? There is a QDoc on a similar subject but it has to do with Developer Toolkit custom OLE controls which this is not. strsql = "SELECT testcaseid,execcounter,screenshotref FROM [tblTCScreenShot]" Set rs = dbCur.OpenRecordset(strsql, dbOpenSnapshot) If rs.RecordCount <> 0 Then For intI = 0 To dbCur.Containers("reports").Documents.Count - 1 Set myDoc = dbCur.Containers("reports").Documents(intI) If myDoc.Name Like "Report*" Then DoCmd.DeleteObject acReport, myDoc.Name End If Next intI rs.MoveLast rs.MoveFirst ReDim arstrReportName(1 To rs.RecordCount) For intI = 1 To rs.RecordCount varreturn = Dir(rs!screenshotref) If varreturn <> "" Then 'Set myObj = GetObject(rs!screenshotref) Set rpt = CreateReport(dbCur.Name, "Template") Set ctl = CreateReportControl(rpt.Name, acObjectFrame, acDetail, "", "", 25, 12) strRef = rs!screenshotref arstrReportName(intI) = rpt.Name 'DoCmd.Close acReport, rpt.Name, acSaveYes 'DoCmd.OpenReport arstrReportName(intI), acViewDesign, , , acHidden Set ctl = Reports(0).Section(0).Controls(0) With ctl .Name = "SS" & intI '.Class = "word.document.8" .OLETypeAllowed = acOLEEither .SourceDoc = strRef '.SourceDoc = myObj .SizeMode = acOLESizeZoom .Action = acOLECreateLink '.SourceItem = myObj End With DoCmd.Close acReport, arstrReportName(intI), acSaveYes rs.MoveNext Else MsgBox "Could not find file " & rs!screenshotref, vbExclamation, APP_CAPTION End If Next intI For intI = 1 To UBound(arstrReportName) If UBound(arstrReportName) > 0 Then DoCmd.OpenReport arstrReportName(intI), acViewPreview Else MsgBox "No attachments found for this report.", vbInformation, APP_CAPTION End If Next intI End If fnPrintScreenShot_Exit: Erase arstrReportName Set myObj = Nothing Set rs = Nothing Set ctl = Nothing Set myDoc = Nothing Set rpt = Nothing If strEMsg <> "" Then MsgBox strEMsg, vbInformation, APP_CAPTION End If Exit function fnPrintScreenShot_Err: Select Case Err Case 7874 Resume Next Case Else strEMsg = Err & " - " & Err.Description Resume fnPrintScreenShot_Exit End Select End function "Things are only free to the extent that you don't pay for them".-Don Elliker _________________________________________________________________ Tired of spam? Get advanced junk mail protection with MSN 8. http://join.msn.com/?page=features/junkmail