Question

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

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

Answer 1

你的SendKeys陈述看错了......为什么圆括号？我的意思是，它们与[CTRL] + [V]序列有什么关系？

尝试：

SendKeys "^{v}", True

在您粘贴的几个地方。

Answer 2

对于任何关注的人：我想我已经为我的机器修了它。我在复制后添加了wait命令，它现在可以在我的机器上运行。对于我的同事来说，它仍然不会粘贴第一个。仍然难倒那个......

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

2 个答案: