VBA 宏停止在新计算机上工作答案

【问题标题】：VBA Macro stops working on new computerVBA 宏停止在新计算机上工作
【发布时间】：2014-07-03 14:59:47
【问题描述】：

所以我有一台新电脑在工作，现在我的宏无法运行。据说所有的设置和程序都和旧的一样。宏会打开并正确处理电子邮件，但不会在发送前粘贴数据。我的同事在他们的机器上尝试过它，除了第一个（不粘贴）之外它可以工作。我难住了！

Sub SendEmail()

    Dim OutlookApp As Object
    'Dim OutlookApp As Outlook.Application
    Dim MItem As Object
    'Dim MItem As Outlook.MailItem

    'Create Outlook object
    Set OutlookApp = CreateObject("Outlook.Application")
    'Set OutlookApp = New Outlook.Application

    Dim Sendrng As Range
    Set Sendrng = Worksheets("APP").Range("A1").SpecialCells(xlCellTypeVisible)
    Sendrng.Copy

    'Create Mail Item
    Set MItem = OutlookApp.CreateItem(0)
    'Set MItem = OutlookApp.CreateItem(olMailItem)
    With MItem
        .To = "xxx@xxx.com"
        .Subject = "APP High Cash"
        .CC = ""
        .BCC = ""
        '.Body = "a"
        .Display
        Wait 2
    End With
    SendKeys "^({v})", True
    Wait 2
    With MItem
        .Send
    End With

    Set OutlookApp = Nothing
    Set MItem = Nothing


    'Create Outlook object
    Set OutlookApp = CreateObject("Outlook.Application")
    'Set OutlookApp = New Outlook.Application

    Set Sendrng = Worksheets("Angie").Range("A1").SpecialCells(xlCellTypeVisible)
    Sendrng.Copy

    'Create Mail Item
    Set MItem = OutlookApp.CreateItem(0)
    'Set MItem = OutlookApp.CreateItem(olMailItem)
    With MItem
        .To = "xxx@xxx.com"
        .Subject = "High Cash"
        .CC = ""
        .BCC = ""
        '.Body = "a"
        .Display
        Wait 2
    End With
    SendKeys "^({v})", True
    Wait 2
    With MItem
        .Send
    End With

    Set OutlookApp = Nothing
    Set MItem = Nothing

    'Create Outlook object
    Set OutlookApp = CreateObject("Outlook.Application")
    'Set OutlookApp = New Outlook.Application

    Set Sendrng = Worksheets("Cathy").Range("A1").SpecialCells(xlCellTypeVisible)
    Sendrng.Copy

    'Create Mail Item
    Set MItem = OutlookApp.CreateItem(0)
    'Set MItem = OutlookApp.CreateItem(olMailItem)
    With MItem
        .To = "xxx@xxx.com"
        .Subject = "High Cash"
        .CC = ""
        .BCC = ""
        '.Body = "a"
        .Display
        Wait 2
    End With
    SendKeys "^({v})", True
    Wait 2
    With MItem
        .Send
    End With

    Set OutlookApp = Nothing
    Set MItem = Nothing

    'Create Outlook object
    Set OutlookApp = CreateObject("Outlook.Application")
    'Set OutlookApp = New Outlook.Application

    Set Sendrng = Worksheets("Corey").Range("A1").SpecialCells(xlCellTypeVisible)
    Sendrng.Copy

    'Create Mail Item
    Set MItem = OutlookApp.CreateItem(0)
    'Set MItem = OutlookApp.CreateItem(olMailItem)
    With MItem
        .To = "xxx@xxx.com"
        .Subject = "High Cash"
        .CC = ""
        .BCC = ""
        '.Body = "a"
        .Display
        Wait 2
    End With
    SendKeys "^({v})", True
    Wait 2
    With MItem
        .Send
    End With

    Set OutlookApp = Nothing
    Set MItem = Nothing

'Create Outlook object
    Set OutlookApp = CreateObject("Outlook.Application")
    'Set OutlookApp = New Outlook.Application

    Set Sendrng = Worksheets("Curt").Range("A1").SpecialCells(xlCellTypeVisible)
    Sendrng.Copy

    'Create Mail Item
    Set MItem = OutlookApp.CreateItem(0)
    'Set MItem = OutlookApp.CreateItem(olMailItem)
    With MItem
        .To = "xxx@xxx.com"
        .Subject = "High Cash"
        .CC = ""
        .BCC = ""
        '.Body = "a"
        .Display
        Wait 2
    End With
    SendKeys "^({v})", True
    Wait 2
    With MItem
        .Send
    End With

    Set OutlookApp = Nothing
    Set MItem = Nothing


End Sub

子等待：

Private Sub Wait(ByVal nSec As Long)
    nSec = nSec + Timer
    While nSec > Timer
        DoEvents
    Wend
End Sub

【问题讨论】：

听起来是个愚蠢的答案，但请尝试将代码复制到新模块中并再次运行。
这可能是一个非常明显的问题......但我还是会问......你的新电脑上是否安装了 Outlook 和 Office 应用程序？
是不是同一个版本的Windows和同一个版本的Excel？
相同版本的 Windows 和 Office。
很抱歉回到旧线程，但它不再工作了。同样的问题...

标签： vba excel outlook

【解决方案1】：

您的SendKeys 语句看起来有误...为什么是圆括号？我的意思是，它们与 [CTRL]+[V] 序列有什么关系？

试试：

SendKeys "^{v}", True

在你粘贴的几个地方。

【讨论】：

【解决方案2】：

对于以下任何人：我想我已经为我的机器修好了它。我在复制之后添加了等待命令，它现在可以在我的机器上运行。对于我的同事，它仍然不只是粘贴第一个。仍然难倒那个...

【讨论】：