XL VBA: assigning Macro to button in programmatically created sheet for emailing

[Steve KRL]

Hi all

Long time lurker, first time (issue) poster :D

I've been going round the bend this last week trying to unpick a very frustrating issue.

I have a macro that I've compiled and adapted from various sources. The Macro:

• Splits data from one sheet into several other tabs, renaming the tabs to correspond to the unique cell values in a given column.
• For each given tab, it then creates a new temporary workbook, copies the data (and an unassigned button) from the tab across to the temporary workbook;
• Renames the workbook to match the tab name;
• Programmatically copies across (using Export, Import) Module 3 from the original workbook - this module contains only one Macro, called "Submit".
• Creates an email in outlook and sends it to the recipient after whom the sheet is named
• Moves on to the next tab.

All works swimmingly right up until the point that the end user clicks on the button in the received file. The macro currently allocates the macro in the originating workbook to the button, not the macro embedded in the new workbook.

Here's the code in full:

Sub Newsheets()
Set asheet = ActiveSheet
LastRow = asheet.Range("I" & Rows.Count).End(xlUp).Row
myarray = uniqueValues(asheet.Range("I7:I" & LastRow))
Application.CopyObjectsWithCells = True
ThisWorkbook.VBProject.VBComponents("Module3").Export ("temp.bas")
 
For i = LBound(myarray) To UBound(myarray)
 Sheets.Add.Name = myarray(i)
 asheet.Range("A6:Z" & LastRow).AutoFilter Field:=9, Criteria1:=myarray(i)
 asheet.Range("A1:Z" & LastRow).SpecialCells(xlCellTypeVisible).Copy _
        Sheets(myarray(i)).Range("A1")
 asheet.Range("A6:Z" & LastRow).AutoFilter
 
   Dim oApp As Object
   Dim oMail As Object
   Dim LWorkbook As Workbook
   Dim LFileName As String
   
   'Turn off screen updating
   Application.ScreenUpdating = False
   
   'Copy the active worksheet and save to a temporary workbook
   ActiveSheet.Copy
   Set LWorkbook = ActiveWorkbook
   
   'Create a temporary file in your current directory that uses the name
   ' of the sheet as the filename
   LFileName = LWorkbook.Worksheets(1).Name
   LWorkbook.VBProject.VBComponents.Import ("temp.bas")
   ActiveSheet.Buttons(1).OnAction = "ThisWorkbook.Submit"
   
   On Error Resume Next
   'Delete the file if it already exists
   Kill LFileName
   On Error GoTo 0
   
   'Save temporary file
   LWorkbook.SaveAs Filename:=LFileName, FileFormat:=52
   
   'Create an Outlook object and new mail message
   Set oApp = CreateObject("Outlook.Application")
   Set oMail = oApp.CreateItem(0)
   Set strTo = Range("I7")
   
   'Set mail attributes
   'In this instance, only the attachment is being added to the mail message
   With oMail
      .To = LFileName
      .SentOnBehalfOfName = "KR Project Finance"
      .Subject = Range("I7") & " Forecast for " & Range("B2") & " " & Range("B4")
      .body = "Automated Submission from Microsoft Excel." & vbCrLf & vbCrLf & _
      "Please find attached your forecast template for this month.  Submissions are required to be submitted using the enclosed Submission button by no later than Time on Date.  Many thanks for your co-operation."
      .Attachments.Add LWorkbook.FullName
      .Send
   End With
   
   'Delete the temporary file and close temporary Workbook
   LWorkbook.ChangeFileAccess Mode:=xlReadOnly
   Kill LWorkbook.FullName
   LWorkbook.Close SaveChanges:=False
   
   'Turn back on screen updating and clean up set values
   Application.ScreenUpdating = True
   Set oMail = Nothing
   Set oApp = Nothing
    
Next i
Kill ("temp.bas")
End Sub

Private Function uniqueValues(InputRange As Range)
    Dim cell As Range
    Dim tempList As Variant: tempList = ""
    For Each cell In InputRange
        If cell.Value <> "" Then
            If InStr(1, tempList, cell.Value) = 0 Then
                If tempList = "" Then tempList = Trim(CStr(cell.Value)) Else tempList = tempList & "|" & Trim(CStr(cell.Value))
            End If
        End If
    Next cell
    uniqueValues = Split(tempList, "|")
End Function

Any and all ideas appreciated; I just can't seem to get to a solution. Please bear in mind that I'm totally self taught and harvest most of my code off fine forums such as this one...!

Cheers all

Steve

 

[Fazza]

hi, Steve

From a quick read of the code, I wonder if it helps to change the button's onaction value from "ThisWorkbook.Submit" to "Submit"

regards

 

[Steve KRL]

Good timing - just managed to fix it

This issue with just using "Submit" is that it links to the original submit in the file being copied (which is on my PC, unsuprisingly, and so if a broken link).

The problem turned out to be that I wasn't calling the workbook properly (I'm an amateur, and I made an amateur mistake!) when trying to direct it to the name of the Macro - I didn't realise that it wasn't checking to make sure a macro existed with that name when the button was assigned, and so hadn't spotted my error.

I fixed it in the end by replacing

ActiveSheet.Buttons(1).OnAction = "ThisWorkbook.Submit"

with

ActiveSheet.Buttons(1).OnAction = LWorkbook.Name & "!Submit"

Hope that helps anyone else in this situation - it was a real headscratcher!

Credit: http://www.mrexcel.com/forum/excel-questions/539033-programmatically-assign-macro-button.html

 

[Fazza]

well done, Steve
sounds like you've created a handy file