莊生趣味 » VBA / 在Outlook使用VBA批次寄信

文章索引

Post Views: 462

VBA / 使用Excel VBA批次寄信

是透過引用 CDO.Message物件的方式來傳遞信件

但是這個方式不會在自己的信箱留下紀錄

所以嘗試在 outlook透過VBA來寄信

這樣在寄件備份就會有資料

首要工作是設定 outlook郵件帳號

VBA會使用預設的郵件帳號來發出信件

接著是讓 outlook能夠抓取來自Excel的信件資料

這時候就要在 outlook引用 Excel Application物件

不過抓取工作表最後一列的位置時

在 Excel可以使用Range.End(xlDown).Row來取得

但是 outlook VBA如果用晚期繫結中引用 Excel Application物件的Range.End(xlDown)會出現錯誤

如果先引用 Excel library就能夠正常使用

不知道是不是繫結的差異

備註：後來爬文，有人說可以改成在End( )帶入XlDirection數值

If you want to have the ability to use Excel constants within your code, you will need to either
a) Include a reference to a Microsoft Excel Object Library, or
b) Create your own constant, e.g.
    End(-4162)
or
    Const xlUp As Long = -4162
    ...
    ... End(xlUp)

另外一篇也有人提到「outlook 認不得在Excel的常數」

Outlook 2007 must not recognize the Excel Constants, whereas OL 2010 does.
Instead of writing xlUp write the enumeration for xlUp which is -4162.

在 outlook VBA 選取工作表儲存格要將完整的路徑列出來

例如：excelMail.ActiveWorkbook.Sheets(“mail”).Range(“B” & n).Value

否則也會出現錯誤

整體而言，雖然引用 Excel Application物件可以操作Excel

但還是不完全等於在 Excel環境裡

以下為完整的測試程式碼

'
Public Sub sendMail2()
   ' Dim excelMail As Excel.Application                    '早期繫結
    Dim excelMail As Object                                '晚期繫結
    Dim mail As Outlook.MailItem
    Dim DataPath As String 'excle檔案路徑
    Dim r As Integer
    Dim n As Integer
    Dim e As String '內文編碼
    Dim t As String '收件者
    Dim s As String '主旨
    Dim b As String '內文
    Dim a As String '附件
    
    DataPath = "....\xxxxxxx.xlsx"
   ' Set excelMail = New Excel.Application                 '早期繫結
    Set excelMail = CreateObject("excel.application")      '晚期繫結
    
    With excelMail
        .Visible = False
        .Workbooks.Open (DataPath)
    End With
    
    'MsgBox TypeName(excelMail)      'application
'    r = excelMail.ActiveWorkbook.Sheets("mail").UsedRange.Rows.Count  '取得列數
'    r = excelMail.ActiveWorkbook.Sheets("mail").Range("A1").End(xlDown).Row     '取得列數  出現錯誤
    r = excelMail.ActiveWorkbook.Sheets("mail").Range("A1").End(-4121).Row       'xlDown 改成 -4121

'    MsgBox r

    If r <> 1045678 Then
        For n = 2 To r
            If excelMail.ActiveWorkbook.Sheets("mail").Range("A" & n) <> "" Then  '路徑要完整 不然會出錯
                e = excelMail.ActiveWorkbook.Sheets("mail").Range("B" & n).Value
                t = excelMail.ActiveWorkbook.Sheets("mail").Range("D" & n).Value
                s = excelMail.ActiveWorkbook.Sheets("mail").Range("E" & n).Value
                b = excelMail.ActiveWorkbook.Sheets("mail").Range("F" & n).Value
                a = excelMail.ActiveWorkbook.Sheets("mail").Range("G" & n).Value

                Set mail = Application.CreateItem(olMailItem)
                If e = "txt" Then
                    With mail
                        .To = t
                        .Subject = s
                        .BodyFormat = olFormatPlain
                        .Body = b
                        .Attachments.Add a
                        .Send
                    End With
                
                ElseIf e = "html" Then
                    With mail
                        .To = t
                        .Subject = s
                        .BodyFormat = olFormatHTML
                        .HTMLBody = b
                        .Attachments.Add a
                        .Send
                    End With
                Else
                    
                    MsgBox "請確認內文編碼格式"
                
                End If
                
            End If
            
            Set mail = Nothing
        Next
    End If
    
    excelMail.Quit
    
    Set excelMail = Nothing
    
End Sub