Question

我根本不是这方面的专家，但我有一张excel表，我希望自动生成并每天通过电子邮件发送。现在，Excel中的值将从DB更新，以便进行处理。我的桌面上有工作表。我想在Windows Vista中使用任务计划程序但不确定这是否正确。

我需要打开工作表...更新...然后通过电子邮件发送到xxxx @ xxx的更新版本有任何想法或提示如何做到这一点？我从网上下载并发送电子邮件的代码是：

Sub Mail_ActiveSheet()
'Working in 97-2010
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim I As Long

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

Set Sourcewb = ActiveWorkbook

'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
    If Val(Application.Version) < 12 Then
        'You use Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007-2010, we exit the sub when your answer is
        'NO in the security dialog that you only see  when you copy
        'an sheet from a xlsm file with macro's disabled.
        If Sourcewb.Name = .Name Then
            With Application
                .ScreenUpdating = True
                .EnableEvents = True
            End With
            MsgBox "Your answer is NO in the security dialog"
            Exit Sub
        Else
            Select Case Sourcewb.FileFormat
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
    End If
End With

'    'Change all cells in the worksheet to values if you want
'    With Destwb.Sheets(1).UsedRange
'        .Cells.Copy
'        .Cells.PasteSpecial xlPasteValues
'        .Cells(1).Select
'    End With
'    Application.CutCopyMode = False

'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " _
             & Format(Now, "dd-mmm-yy h-mm-ss")

With Destwb
    .SaveAs TempFilePath & TempFileName & FileExtStr, _
            FileFormat:=FileFormatNum
    On Error Resume Next
    For I = 1 To 3
        .SendMail "dsdsdsd@hotmail.com", _
                  "dsds,dsd, dsdsdsds report"
        If Err.Number = 0 Then Exit For
    Next I
    On Error GoTo 0
    .Close SaveChanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub

Answer 1

通过文本编辑器（例如NotePad）将代码保存为vbs，类似“myscript.vbs”。 请注意，这不是VBA
使用How to use the Windows Task Scheduler中的说明安排vbs
如果您的电子邮件是通过Outlook发送的，请使用clickyes来绕过Outlook警告。（如果您确认这一点，我会在代码中添加更多自动化以强制发送/接收

请在此处更改桌面文件的路径
strWB = "C:\temp\test.xls"

某些代码似乎是多余的，即保存和终止文件无关紧要，因为SendMail直接工作（而使用Outlook则需要添加已保存的附件）。文件版本似乎没有增加值

    Dim objExcel
    Dim objOutlook
    Dim objWB
    Dim objws
    Dim strWB
    Dim strWB2
    'Change file path to be emailed
    strWB = "C:\temp\test.xls"
    Set objExcel = CreateObject("Excel.Application")
    objExcel.DisplayAlerts = False
    Set objWB = objExcel.Workbooks.Open(strWB)
    'Change sheet index as needed
    Set objws = objWB.Sheets(1)
    objws.Copy
    With objExcel.ActiveWorkbook
        .SendMail "brt@notmyemail.net.au", "test"
        .Close False
    End With
    objWB.Close False
    With objExcel
        .DisplayAlerts = True
        .Quit
    End With

加载工作表时要执行的Excel VBA代码

1 个答案: