高分求解outlook问题

想做一个功能，在VB中调用Outlook功能，新建并弹出outlook窗口，实现如下：

Dim OutLooks As Outlook.Application
Private Sub Command1_Click()
        Call send_mail("Then   IA   CODE   is   going   to   run   out! ")
End Sub

Public Function OutLookMailto(OutLooks As Outlook.Application, _
                ByVal strSubject As String, _
                ByVal strText As String, colAddrList As Collection, _
                colAttachments As Collection) As Boolean
        Dim Mail     As MailItem
        Dim strTemp
        Set OutLooks = New Outlook.Application
        Set Mail = OutLooks.CreateItem(olMailItem)           '設定要一個新的Mail   Item
        With Mail
        For Each strTemp In colAddrList
                .Recipients.Add strTemp       '新增收件人
        Next
        '           For   Each   strTemp   In   colAttachments
        '                   .Attachments.Add   strTemp       'Attach的File
        '           Next
        .Subject = strSubject           '主旨
        .Body = strText                       '內容
        .Save                                       '存入寄件夾
        .Display
'        .Send                                       '出信件
        
        End With
        Set Mail = Nothing
        OutLookMailto = True
        Exit Function
Errh:
  OutLookMailto = False
End Function

Private Sub send_mail(ByVal strSubject As String)
        Dim colAddrs As New Collection
        Dim colAttachs As New Collection
        Dim strBody As String
        Dim strText As String
        Dim blnSendOK As Boolean
        Dim SQL As String
        '       SQL   =   "select   email_address   from   sftm40   where   email_group   =   'ME ' "
        '       Set   RS   =   DB.Execute(SQL)
        '   strBody   =   "您好： "   &   vbCrLf   &   "   您看到這封信時表示已成功傳送 "
        'While   Not   RS.EOF
        colAddrs.Add "[e-mail] "     ' "[e-mail] "   'Trim(RS.Fields( "email_address "))
        '       RS.MoveNext
        'Wend
        'colAttachs.Add   mFile
        colAttachs.Add " "
        strText = "   The   has   already   run   out,   please   send   the   new   range   to   Arima   S/W   team.& " _
                        & "   Thank   you   very   much!   This   mail   for   test   program.   "
        blnSendOK = OutLookMailto(OutLooks, strSubject, strText, colAddrs, colAttachs)
        If blnSendOK = True Then
                MsgBox "弹出窗口成功! ", vbInformation
        Else
                MsgBox "弹出窗口未成功! ", vbInformation
        End If
        'End
End Sub

但有一个问题未能解决，在Outlook已打开的情况下，执行Set OutLooks = New Outlook.Application这句会报错（ActiveX component can't create object），这个问题如何解决？

12 个解决方案

#1

没人会吗？看来VB真没人用了。。。

#2

该回复于2012-06-21 11:01:41被版主删除

#3

该回复于2012-06-21 11:01:57被版主删除

#4

该回复于2012-05-31 08:55:19被版主删除

#5

我的没问题啊，你引用的是哪个OUTLOOK库

#6

引用 5 楼  的回复:

我的没问题啊，你引用的是哪个OUTLOOK库

我引用的是microsoft Outlook 12.0 Object Library

#7

microsoft Outlook 12.0 Object Library的话,那就是Outlook2007咯.

这个版本真的很无爱唉. 功能和02基本一样, 原来的问题一个没解决, 速度倒是慢了一大截. 

不好意思, 变成吐槽了, 主要是这个编程用的不多, 不像Excel方面做的比较多. 所以帮不上忙咯.

#8

继续求助，各位高人快点现身吧

#9

但有一个问题未能解决，在Outlook已打开的情况下，执行Set OutLooks = New Outlook.Application这句会报错（ActiveX component can't create object），这个问题如何解决？
=====================================================================
先判断一下OutLook是否打开，如果打开则使用GetObject()返回其实例即可。

#10

引用 9 楼  的回复:

但有一个问题未能解决，在Outlook已打开的情况下，执行Set OutLooks = New Outlook.Application这句会报错（ActiveX component can't create object），这个问题如何解决？
=====================================================================
先判断一下……

谢谢你的回复，能否写几行代码参考一下？万分感谢！

#11

本帖最后由 bcrun 于 2012-06-21 11:02:58 编辑

  On Error Resume Next

    outlookObj = GetObject(, "Outlook.Application")
    If Err.Number = 0 Then
        MsgBox("Outlook is running")
    Else
        MsgBox("Outlook is not running")
        Set outlookObj = New Outlook.Application
    End If
    Err.Clear()
    .........
    outlookObj = Nothing

没测试，思路应该是这样

#12

引用 11 楼  的回复:

    On Error Resume Next

    outlookObj = GetObject(, "Outlook.Application")
    If Err.Number = 0 Then
        MsgBox("Outlook is running")
    Else
        MsgBox("Outlook is ……

还是不行啊