Блог

Главная - Вопросы по программированию - Макрос VBA перестает работать на новом компьютере

Макрос VBA перестает работать на новом компьютере

#vba #excel #outlook

#vba #excel #outlook

Вопрос:

Итак, я получил новый компьютер на работе, и теперь мой макрос не запускается. Предположительно, все настройки и программы такие же, как на старом. Макрос открывается и адресует электронные письма должным образом, но не вставляет данные перед отправкой. Мой коллега попробовал его на своей машине, и он работает, ЗА исключением первого (не вставляется). Я в тупике! 

 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

Комментарии:

1. Звучит как глупый ответ, но попробуйте скопировать код в новые модули и запустить их снова.

2. Это может быть очень очевидным вопросом… но я все равно спрошу об этом …. на вашем новом компьютере установлены приложения Outlook и Office?

3. Это одна и та же версия Windows и одна и та же версия Excel?

4. Те же версии Windows и Office.

5. Извините, что возвращаюсь к старому потоку, но он снова не работает. Та же проблема…

Ответ №1:

Ваше SendKeys утверждение выглядит неправильно… почему круглые скобки? Я имею в виду, какое отношение они имеют к последовательности [CTRL] [V]?

Попробуйте:

 SendKeys "^{v}", True

в нескольких местах, куда вы вставляете.

Ответ №2:

Для всех, кто следит: я думаю, что я исправил это для своей машины. Я добавил команду wait после копирования, и теперь она работает на моем компьютере. Для моего коллеги он по-прежнему не вставляет только первый. Все еще в тупике с этим…