Hello all, and Happy New Year,
I have tried to find a solution to an issue I've encountered, but haven't been successful so I am hoping someone can assist. I am running into a problem where a macro that I've been trying to utilize will not function properly if Outlook is not open. I have limited experience using macros and vba, so I apologize in advance if I've missed anything that a proficient programmer such as yourselves would know to resolve.
The macro I've incorporated into the workbook and have been testing for a day now was posted online by Ron de Bruin, and I've tweaked slightly, and has been working great for me; however, during testing recently, I encountered a scenario that I cannot figure out how to resolve. It does not function correctly if Outlook is closed when the macro is run.
The workbook is going to be sent to a user group who will complete the workbook, and then at the bottom of the sheet they are supposed to click a button that will run a macro to automatically send the workbook as an attachment in Outlook. The issue I cannot solve for that I really need help with is that I continuously receive errors when trying to run the macro when Outlook is closed. I've tried several solutions located in various postings, but nothing seems to work.
I've provided some details below if any would be able to suggest a resolution.
Errors received:
1) [Microsoft Outlook popup] ---------> Microsoft Outlook has stopped working. Windows is checking for a solution to the problem...
2) [Microsoft Visual Basic popup] ---> Run-time error '429': ActiveX component can't create object
err_macro_outlook-closed.png
vb_err429.png
System specs:
Office Professional 2013
Windows 7
Current VB code:
Code:
Sub Employee_Mail_workbook_to_Mgr_Outlook_3()
'Working in Excel 2000-2013
'Mail a changed copy of the ActiveWorkbook with another file name
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb1 = ActiveWorkbook
'Make a copy of the file/Open it/Edit it/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = "Survey - " & ThisWorkbook.Sheets("Sheet1").Range("D1").Value & "_" & ThisWorkbook.Sheets("Sheet1").Range("D2").Value & "_" & Format(Now, "yyyymmdd hhmmss")
FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)
'**************Add code to edit the file here********************
'Insert a text and Date in cell A1 of the first sheet in the workbook.
'Other things you can think of are for example, delete a whole sheet or a range.
wb2.Worksheets(1).Range("C44").Value = "Electronically signed: " & Format(Now, "mm/dd/yyyy hh:mm:ss") & " by " & Environ("userdomain") & "\" & Environ("username")
ActiveSheet.Buttons("Button 1").Delete
'Save the file after we changed it with the code above
wb2.Save
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = ThisWorkbook.Sheets("Custom").Range("B14").Value
.CC = ThisWorkbook.Sheets("Custom").Range("B20").Value
.BCC = ""
.Subject = ThisWorkbook.Sheets("Custom").Range("B10").Value
.Body = ThisWorkbook.Sheets("Custom").Range("B4").Value
.Attachments.Add wb2.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
wb2.Close SaveChanges:=False
'Delete the file
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Thank you in advance for any assistance you can provide :)