Consulting

Results 1 to 6 of 6

Thread: Send E-Mail via Macro if Workbook was saved and the was name changed aswell

  1. #1

    Send E-Mail via Macro if Workbook was saved and the was name changed aswell

    Hi all,

    I got a little problem that I canīt quite solve with my VBA knowledge, unfortunatley. I want a macro that automatically sends an e-mail if two conditions are met 1. that the workbook was saved and 2. that the name of this workbook was changed aswell. I used the following code, but it does not seem to do the trick. As highlighted I tried it with an If-statement with two conditions. I open and thankful for any helping suggestions.

    Option Explicit


    'Send email if name of workbook is changed


    Private Sub WorkbookName_Change()
    Dim xOutApp As Object
    Dim xMailItem As Object
    Dim xMailBody As String, xName As String, wbName As String
    Dim Change

    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    wbName = ThisWorkbook.Name

    If ThisWorkbook.Saved = True Then
    If wbName <> ActiveWorkbook.Name Then
    Set xOutApp = CreateObject("Outlook.Application")
    Set xMailItem = xOutApp.CreateItem(0)
    xMailBody = "Hallo," & Chr(13) & Chr(13) & "Fyi, die Datei wurde geupdated ."
    With xMailItem
    .To = ""
    .CC = ""
    .Subject = "Worksheet modified in " & ThisWorkbook.FullName
    .Body = xMailBody
    .Attachments.Add (ThisWorkbook.FullName)
    .Display
    End With
    Set xOutApp = Nothing
    Set xMailItem = Nothing
    End If
    End If
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    End Sub

    kind regards,
    Felix

  2. #2
    VBAX Tutor MINCUS1308's Avatar
    Joined
    Jun 2014
    Location
    UNDER MY DESK
    Posts
    254
    IN THE ThisWorkbook MODULE:

    Public InitialName
    
    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    InitialName = ActiveWorkbook.Name
    End Sub Private Sub Workbook_AfterSave(ByVal Success As Boolean)
    If Not Success Then Exit Sub If ActiveWorkbook.Name <> InitialName Then SendEmail
    End Sub Sub SendEmail() 'YOUR EMAIL SUB GOES HERE Dim xOutApp As Object Dim xMailItem As Object Dim xMailBody As String, xName As String, wbName As String Dim Change On Error Resume Next Application.ScreenUpdating = False Application.DisplayAlerts = False Set xOutApp = CreateObject("Outlook.Application") Set xMailItem = xOutApp.CreateItem(0) xMailBody = "Hallo," & Chr(13) & Chr(13) & "Fyi, die Datei wurde geupdated ." With xMailItem .To = "" .CC = "" .Subject = "Worksheet modified in " & ThisWorkbook.FullName .Body = xMailBody .Attachments.Add (ThisWorkbook.FullName) .Display End With Set xOutApp = Nothing Set xMailItem = Nothing Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
    - I HAVE NO IDEA WHAT I'M DOING

  3. #3
    Thanks a lot, that works excactly as I imagined

  4. #4
    Very nice never thought of creating a email for tracking changes.

    Mincus, might try something like this for my problem.
    http://www.vbaexpress.com/forum/show...rom-a-workbook

  5. #5
    VBAX Tutor MINCUS1308's Avatar
    Joined
    Jun 2014
    Location
    UNDER MY DESK
    Posts
    254
    ha, that's surprising (the fact that it worked)
    Welcome to the fourm Fabbby-San

    If you can, please mark the thread as solved by going to the 'Thread Tools' button at the top right corner of the thread.
    - I HAVE NO IDEA WHAT I'M DOING

  6. #6
    VBAX Tutor MINCUS1308's Avatar
    Joined
    Jun 2014
    Location
    UNDER MY DESK
    Posts
    254
    nathandavies,

    You certainly could apply this methodology to your problem.
    Just change the events from BeforeSave and AfterSave to SelectionChange and Change
    and modify the sub/logic a little.
    - I HAVE NO IDEA WHAT I'M DOING

Posting Permissions

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