Temp file not saving macros

[j.millar]

Hello!
I've created a form for my work colleagues to complete when they want to start a new project.
The form is completed by the project leader, then they hit a Command Button and it's sent to the Senior Manager. After the Senior Manager looks at it and approves it, he then sends it on to Admin (me!) so the project can get set up on all of our systems.
We recently upgraded to Office 2007 (yes, we are a bit late!) and now the Macro that sends the form to Admin no longer works. An example of the error is as follows:
Cannot run the Macro "FY06-10 PROJECTS 19-Jan-10 08-32'EmailtoAdmin.EmailtoAdmin'. The macro may not be available in this workbook or all Macros may be disabled.

Here is the code that I use to send it to the Senior Manager:
Sub MailtoSM()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook

With Destwb
If Val(Application.Version) < 12 Then

FileExtStr = ".xls": FileFormatNum = -4143
Else

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
TempFilePath = Environ$("temp") & "\"
TempFileName = Sourcewb.Sheets("Proj. Advice").Range("AC6").Value & " " & Format(Now, "dd-mmm-yy HH-MM")
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=52
On Error Resume Next
.SendMail Sheets("Proj. Advice").Range("R54").Value, "Project Commencement Advice"
On Error GoTo 0
.Close SaveChanges:=False
End With

' Delete the file you just sent.
Kill TempFilePath & TempFileName & FileExtStr
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your form has now been submitted to your Senior Manager."
End Sub


And this is the code to send it to Admin:
Sub EmailtoAdmin()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook

With Destwb
If Val(Application.Version) < 12 Then

FileExtStr = ".xls": FileFormatNum = -4143
Else

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
TempFilePath = Environ$("temp") & "\"
With Destwb
ActiveWorkbook.SaveAs TempFilePath, FileFormat:=52
On Error Resume Next
.SendMail Sheets("Proj. Advice").Range("W54", "W55").Value, "Project Commencement Advice"
On Error GoTo 0
.Close SaveChanges:=False
End With

' Delete the file you just sent.
Kill TempFilePath & TempFileName & FileExtStr
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your form has now been submitted to Administration."
End Sub

Have I gone crazy and forgotton something completely obvious, or am I not as dumb as I thought

Thanks!

 

[woodycanuck]

I got a copy of the file. Here's where we're at with this:

Set Sourcewb = ActiveWorkbook

ActiveSheet.Copy
Set Destwb = ActiveWorkbook

The code for the buttons is sitting in modules, apart from the worksheet backend code. So when the worksheet gets copied into the new workbook, it is not bringing the module code with it.

Is there a way to just copy the entire workbook? Or does she need to programatically copy the module code over?

 

[dscg]

See example 2 to send the whole workbook:

http://www.rondebruin.nl/mail/folder1/mail1.htm

 

[j.millar]

Thanks, the link was very helpful, I'm just having a slight problem now, in that it won't create the email or attachment and comes up with a 454 error.
My code goes as:
Sub EmailtoSM()
'Working in 2000-2007
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Set wb1 = ActiveWorkbook
If Val(Application.Version) >= 12 Then
If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
MsgBox "There is VBA code in this xlsx file, there will" & vbNewLine & _
"be no VBA code in the file you send. Save the" & vbNewLine & _
"file first as xlsm and then try the macro again.", vbInformation
Exit Sub
End If
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Make a copy of the file/Open it/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = Source.Sheets("Proj. Advice").Range("AC6").Value & " " & Format(Now, "dd-mmm-yy HH-MM")
FileExtStr = "." & LCase(Right(wb1.Name, _
Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)
With wb2
On Error Resume Next
.SendMailThisWorkbook("Proj. Advice").Range("R54").Value , "Project Commencement Advice"
On Error GoTo 0
.Close SaveChanges:=False
End With
'Delete the file
Kill TempFilePath & TempFileName & FileExtStr
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your form has now been submitted to your Senior Manager."
End Sub

The Debugger points to the line:
TempFileName = Source.Sheets("Proj. Advice").Range("AC6").Value & " " & Format(Now, "dd-mmm-yy HH-MM")

Any thoughts on what I'm doing wrong??

 

[woodycanuck]

Where did Source come from? Should be:

TempFileName =  wb1.Sheets("Proj. Advice").Range("AC6").Value & " " & Format(Now, "dd-mmm-yy HH-MM")