VBS崩溃擅长

时间:2015-06-25 13:43:00

标签: excel vba excel-vba

我有4个宏:

1)ThisWorkbook.Turn_Off_Alerts:关闭excel警报
2)Refresh_Base:从SQL连接更新数据
3)Refresh_Pivot:从基础数据刷新数据透视表并保存工作簿。
4)Send_Range_Or_Whole_Worksheet_With_MailEnvelope:将数据透视表发送给一组用户

每个都单独运行,但为了简化一点,我也创建了

Run_All按顺序调用这4个宏。我从在线复制了一个vbs文件来运行这个报告,但是当我执行它时,我得到一个" Microsoft Excel已停止工作"消息和已完成的消息,但电子邮件未发送,文件未保存。这是我正在使用的代码:

     Option Explicit

     Dim xlApp, xlBook

     Set xlApp = CreateObject("Excel.Application")
     Set xlBook = xlApp.Workbooks.Open("Y:\Overrides Expiring in next 30 days.xlsm", 0, True)
     xlApp.Run "Run_All"
     xlBook.Close
     xlApp.Quit

     Set xlBook = Nothing
     Set xlApp = Nothing

     WScript.Echo "Finished."
     WScript.quit

编辑:这是打破它的宏。它虽然在excel中工作。

     Sub Send_Range_Or_Whole_Worksheet_with_MailEnvelope()
     'Working in Excel 2002-2013
     'Declare a String variable for the recipient list, and an Integer         variable
     'for the count of cells in column A that contain email addresses.
     Dim strTo As String
     Dim i As Integer

Dim AWorksheet As Worksheet
Dim Sendrng As Range
Dim rng As Range

On Error GoTo StopMacro

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

'Fill in the Worksheet/range you want to mail
'Note: if you use one cell it will send the whole worksheet
Set Sendrng = Worksheets("Pivot").Range("A1:B15")

'Remember the activesheet
Set AWorksheet = ActiveSheet

With Sendrng

    ' Select the worksheet with the range you want to send
    .Parent.Select

    'Remember the ActiveCell on that worksheet
    Set rng = ActiveCell

    'Select the range you want to mail
    .Select

    ' Create the mail and send it
    ActiveWorkbook.EnvelopeVisible = True
    With .Parent.MailEnvelope

        ' Set the optional introduction field thats adds
        ' some header text to the email body.
        .Introduction = "All, I have attached a list of overrides expiring within the next 30 days. This is an automated message, refreshing every 3 weeks, If you need this report update in my absence please go to Y:\Reports\LTOmacro.vbs . Thank you"

        With .Item
            .To = "myemail@email.com"
            .CC = ""
            .BCC = ""
            .Subject = "LeadTime Overrides Expiring 30 Days"
            .Attachments.Add ActiveWorkbook.FullName
            .Send
        End With

    End With

    'select the original ActiveCell
    rng.Select
End With

'Activate the sheet that was active before you run the macro
AWorksheet.Select

StopMacro:
With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
ActiveWorkbook.EnvelopeVisible = False

End Sub

0 个答案:

没有答案