使用SendObject从Access发送Excel对象,电子邮件中没有附件

时间:2014-02-25 15:05:52

标签: email ms-access-2007 access-vba excel-2007

亲爱的StackOverflowers,

我正在尝试使用VBA中的SendObject从Access发送Excel对象。

我有制作图表的代码:

    Dim oXL As Object        ' Excel application
    Dim oBook As Object      ' Excel workbook
    Dim oSheet As Object     ' Excel Worksheet
    Dim oChart As Object     ' Excel Chart


    Const cNumCols = 100      ' Number of points in each Series
    Const cNumRows = 26       ' Number of Series

    ReDim aTemp(1 To cNumRows, 1 To cNumCols)   

    Set oXL = CreateObject("Excel.application")
    Set oBook = oXL.Workbooks.Add
    Set oSheet = oBook.Worksheets.Item(1)

Dim rs01 As DAO.Recordset
Set rs01 = CurrentDb.OpenRecordset("SELECT * FROM qryWOperweekCombined")

Dim Teller As Integer
Teller = 0
Dim iRow As Integer
iRow = 1
Dim iCol As Integer
iCol = 5

With rs01
If .RecordCount > 0 Then
    .MoveLast
    TotRecords = .RecordCount
    .MoveFirst   
           For Teller = 1 To TotRecords
                 aTemp(iRow, 1) = !Week
                 aTemp(iRow, 2) = !Total
                 aTemp(iRow, 3) = !companyk
                 aTemp(iRow, 4) = !companyv
                .MoveNext
                iRow = iRow + 1
            Next Teller
    oSheet.Range("A1").Resize(cNumRows, cNumCols).Value = aTemp
End If
End With

    Set oChart = oSheet.ChartObjects.Add(200, 1, 745, 380).Chart

oChart.SetSourceData Source:=oSheet.Range("A1:D26")

    oXL.Visible = True

oChart.HasLegend = True
oChart.HasTitle = True

oChart.SeriesCollection(4).ApplyDataLabels
oChart.SeriesCollection(4).DataLabels.Format.TextFrame2.TextRange.Font.Size = 7
oChart.SeriesCollection(2).ApplyDataLabels
oChart.SeriesCollection(2).DataLabels.Format.TextFrame2.TextRange.Font.Size = 7
oChart.SeriesCollection(3).ApplyDataLabels
oChart.SeriesCollection(3).DataLabels.Format.TextFrame2.TextRange.Font.Size = 7

oSheet.Columns("A:A").ColumnWidth = 18.71

    oChart.SeriesCollection(1).Name = "=""Dates"""
    oChart.SeriesCollection(1).XValues = "=Sheet1!$A:$A"
    oChart.SeriesCollection(2).Name = "=""Total"""
    oChart.SeriesCollection(2).XValues = "=Sheet1!$B:$B"
    oChart.SeriesCollection(3).Name = "=""companyk"""
    oChart.SeriesCollection(3).XValues = "=Sheet1!$C:$C"
    oChart.SeriesCollection(4).Name = "=""companyv"""
    oChart.SeriesCollection(4).XValues = "=Sheet1!$D:$D"
    oChart.SeriesCollection(1).Delete
    oChart.SeriesCollection(1).Name = "=""Total"""
    oChart.SeriesCollection(1).XValues = "=Sheet1!$A:$A"

oChart.SeriesCollection(1).Interior.Color = vbBlue
oChart.SeriesCollection(2).Interior.Color = vbGreen
oChart.SeriesCollection(3).Interior.Color = vbRed

oChart.SeriesCollection(1).Trendlines.Add
oChart.SeriesCollection(2).Trendlines.Add
oChart.SeriesCollection(3).Trendlines.Add

    oChart.SeriesCollection(1).Trendlines.Add(Type:=xlMovingAvg, Period:= _
        2, Forward:=1, Backward:=0, DisplayEquation:=False, DisplayRSquared:= _
        False, Name:="Average").Select
    oChart.SeriesCollection(2).Trendlines.Add(Type:=xlMovingAvg, Period:= _
        2, Forward:=1, Backward:=0, DisplayEquation:=False, DisplayRSquared:= _
        False, Name:="Average").Select
    oChart.SeriesCollection(3).Trendlines.Add(Type:=xlMovingAvg, Period:= _
        2, Forward:=1, Backward:=0, DisplayEquation:=False, DisplayRSquared:= _
        False, Name:="Average").Select

With oChart.SeriesCollection(1).Trendlines(1).Border
 .ColorIndex = 5
 .Weight = xlThick
 .LineStyle = xlContinuous
 End With

 With oChart.SeriesCollection(1).Trendlines(2).Border
 .ColorIndex = 5
 .Weight = xlMedium
 .LineStyle = xlContinuous
 End With

With oChart.SeriesCollection(2).Trendlines(1).Border
 .ColorIndex = 4
 .Weight = xlThick
 .LineStyle = xlContinuous
 End With

 With oChart.SeriesCollection(2).Trendlines(2).Border
 .ColorIndex = 4
 .Weight = xlMedium
 .LineStyle = xlContinuous
 End With

With oChart.SeriesCollection(3).Trendlines(1).Border
 .ColorIndex = 3
 .Weight = xlThick
 .LineStyle = xlContinuous
 End With

 With oChart.SeriesCollection(3).Trendlines(2).Border
 .ColorIndex = 3
 .Weight = xlMedium
 .LineStyle = xlContinuous
 End With

 oChart.Legend.Position = xlBottom

 oChart.SetElement (msoElementChartTitleCenteredOverlay)

 oChart.HasTitle = True
 oChart.ChartTitle.Text = "Workorders per week - last 26 weeks"

   oSheet.Visible = True
   oXL.UserControl = True

我有一个发送电子邮件的代码:

Dim varName As Variant
Dim varCC As Variant
Dim varSubject As Variant
Dim varBody As Variant

varName = "name@server.com"
varCC = "name2@server2.com"

varSubject = "Hello"

varBody = "Text bla bla bla"

DoCmd.SendObject , oXL, acFormatXLS, varName, varCC, , varSubject, varBody, False, False

当我合并这些时,我得到一个发送电子邮件的代码,但它没有excel附件就到了(它还在打开Excel,但我会稍后再说。

这2个代码合并为1个子

为什么它不发送附件的任何想法?我使用了错误的对象名称(oXL),因为oSheet和oBook无法正常工作。或者它是否与excel仍然被打开有关?

2 个答案:

答案 0 :(得分:0)

SendObject适用于Ms对象,例如查询,表单或报告。

如果将前两个参数留空,您也可以使用它发送没有附件的电子邮件。

您正在第二个参数中发送一个Excel对象,该命令忽略该命令。

相反,您应该使用Outlook对象通过邮件see stackoverflow question here将Excel文件作为附件发送。

或者,您可以使用ShellExecute

答案 1 :(得分:0)

非常感谢你的帮助。适合我的示例测试代码是:

Dim olApp As Outlook.Application
Dim objMail As Outlook.MailItem
Set olApp = Outlook.Application
'Create e-mail item'
Set objMail = olApp.CreateItem(olMailItem)
Set objAttachments = objMail.Attachments

With objMail
    .Subject = "Weekly Rapport"
    .Body = "Hi xyz, here is your Weekly Rapport"
    .Recipients.Add "xyz@abc.com"
    .Recipients.ResolveAll
    .Display
End With

objAttachments.Add "C:\Users\USERNAME\Documents\graphs\Test123.xls", olByValue, 1, "Test123"
'objMail.Display
objMail.Send