MS Access运行时错误440操作失败

时间:2020-09-09 21:37:41

标签: vba

我将代码拼凑在一起,以打印和邮寄由项目编号生成的MS Access报告。 Attachments.Add = strExport上的代码错误。任何帮助将不胜感激

Private Sub Command8_Click()
'added here
 Dim olApp As Object
 Dim olMail As Object
 Dim strExport As String
 Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(olMailItem)
 
 'stop adding here

Dim rst As DAO.Recordset

'Public strRptFilter As String   ' not need to use a public variable



Set rst = CurrentDb.OpenRecordset("SELECT DISTINCT [Proj_Nbr],[Project Mgr Emial] FROM  [TblEmailProjects] ORDER BY [Proj_Nbr];", dbOpenSnapshot)

'added here

strList = rst![Project Mgr Emial]
'stop adding here

' make sure that we have data
If rst.RecordCount > 0 Then

    rst.MoveFirst

Do While Not rst.EOF
    strRptFilter = "[Proj_Nbr] = " & Chr(34) & rst![Proj_Nbr] & Chr(34)
    
     ' open the report hidden in preview mode setting the where parameter

     DoCmd.OpenReport "TblProjCost", acViewPreview, , strRptFilter, acHidden

    ' save the opened report

     DoCmd.OutputTo acOutputReport, "TblProjCost", acFormatPDF, "C:\Users\Lisa Burns\Documents\AJI\Deploy DELPHI Projects\" & rst![Proj_Nbr] & ".pdf"
     
     'added here
    strExport = "C:\Users\Lisa Burns\Documents\AJI\Deploy DELPHI Projects\" & rst![Proj_Nbr] & ".pdf"
    'stopped adding here
    
    ' close the report

      DoCmd.Close acReport, "TblProjCost"

    DoEvents
    rst.MoveNext
'Moved to after End With
'Loop

'End If ' rst.RecordCount > 0

'Moved all above to after End With

'Generates email information
With olMail
    'olFormatPlain is easier to type in an email with, my opinion only, this line is not needed
    '.BodyFormat = olFormatPlain
    'Who the email is going to, using the strList created during loop above
    .To = strList
    .CC = "" 'Change if you want a CC
    .BCC = "" 'Change is you want a BCC
    .Subject = "Carry Ins"
    .Body = "" 'Change to what ever you want the body of the email to say
    'Attaches the exported file using the variable created at beginning
    .Attachments.Add = strExport
    .Display 'Use for testing purposes only, note out for live runs
    '.Send 'Use for live purposes only, note out for test runs
End With

Loop

End If ' rst.RecordCount > 0

'Frees email objects stored in memory
Set olMail = Nothing
Set olApp = Nothing
'stop added here
rst.Close
Set rst = Nothing
End Sub

0 个答案:

没有答案
相关问题