+ Reply to Thread
Results 1 to 1 of 1

Automatic update pivottable in closed workbook and email macro

Hybrid View

  1. #1
    Registered User
    Join Date
    12-08-2014
    Location
    Poland
    MS-Off Ver
    2013
    Posts
    87

    Automatic update pivottable in closed workbook and email macro

    Hi Excel Experts,

    I have a macro which update a pivot table and if there is a change in pivot table send an e-mail if not saved and closed workbook (the workbook is open automatically by windows scheduler).
    The problem concern closing whole Excel 2013 window.
    If there is no change in PT my workbook does not close and I see a grey window of excel and when there is a change after update and sending email, I see my pivot table in open workbook.

    How sould I modified a code to closed workbook no meter if there is a change or no in PT.

    Thanks for help !

    Function WBcount() As Byte
    WBcount = Application.Workbooks.Count
    End Function
    Private Sub Workbook_Open()
    Dim RowNoB As Long
    Dim RowNoA As Long
    
    With ActiveSheet.PivotTables("Tabela przestawna1")
      RowNoB = .TableRange2.Rows.Count
      .PivotCache.Refresh
      RowNoA = .TableRange2.Rows.Count
    End With
    
    Application.DisplayAlerts = False
    If RowNoB = RowNoA Then
      If Not WBcount = 1 Then
        ThisWorkbook.Close True
      Else
        Application.Quit
      End If
    End If
    Application.DisplayAlerts = True
    
     'Working in 2000-2007
        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 OutApp As Object
        Dim OutMail As Object
    
        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 2000-2003
                FileExtStr = ".xls": FileFormatNum = -4143
            Else
                'You use Excel 2007, 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 = "Deadline projektów " _
                     & Format(Now, "dd-mm-yyyy")
    
        Set OutApp = CreateObject("Outlook.Application")
        OutApp.Session.Logon
        Set OutMail = OutApp.CreateItem(0)
    
        With Destwb
            .SaveAs TempFilePath & TempFileName & FileExtStr, _
                    FileFormat:=FileFormatNum
            On Error Resume Next
            With OutMail
                .To = "mymail@.com"
                .CC = ""
                .BCC = ""
                .Subject = "...."
                .Body = "..."
                .Attachments.Add Destwb.FullName
                'You can add other files also like this
                '.Attachments.Add ("C:\Users\....")
                .Send   'or use .Display
            End With
            On Error GoTo 0
            .Close SaveChanges:=False
        End With
    
        'Delete the file you have send
        Kill TempFilePath & TempFileName & FileExtStr
    
        Set OutMail = Nothing
        Set OutApp = Nothing
    
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End Sub
    Attached Files Attached Files
    Last edited by wrybel; 06-29-2015 at 03:19 AM.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Update closed workbook
    By BuZZarD73 in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 01-22-2015, 01:09 PM
  2. Update Cell Value from a Closed Workbook to Another Closed Workbook
    By glennchung in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 10-17-2014, 04:44 PM
  3. [SOLVED] Automatic update from a closed file (not necessarily existing yet)
    By gvaltat in forum Excel Formulas & Functions
    Replies: 6
    Last Post: 06-20-2013, 11:34 AM
  4. How to read update from a closed workbook
    By Gooford in forum Excel General
    Replies: 3
    Last Post: 12-11-2012, 10:27 AM
  5. Cant update data to closed workbook
    By kwik98 in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 11-08-2010, 10:57 PM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1