Error opening workbook sent via email

TripleBlack

New Member
Joined
Oct 6, 2013
Messages
11
Hello everyone, I'm a complete newbe trying to learn VBA. This is my first attempt so apologies for any obvious mistake in the code I'm posting. I'm also not an English native speaker so sorry for my not so perfect English.

I want a userform to pop up once the workbook is opened, here is the code I wrote in "this workbook"

Private Sub Workbook_Open()


If ActiveWorkbook.Name = "Trading Fax.xlsm" Then
Worksheets("Start").Visible = True
Worksheets("Start").Activate

With frmTransactionAssistant
.StartUpPosition = 0
.Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
.Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
.Show
End With
Else
End If
End Sub

I then created a command button that sends copy of the workbook (without saving it) using outlook, here is the code

Private Sub cmdSend_Click()
Range("T23").Value = Me.cboProofer

If Me.cboProofer.Value = "" Then
Me.cboProofer.SetFocus
MsgBox "Please select a person"
Exit Sub
End If


On Error Resume Next
Set oOutlook = GetObject(, "Outlook.Application")
If oOutlook <> "Outlook" Then
MsgBox ("Please open Outlook")
Exit Sub
End If

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


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 as a macro-enabled (. Xlsm) and then retry the macro.", vbInformation
Exit Sub
End If
End If


With Application
.ScreenUpdating = False
.EnableEvents = False
End With


' Make a copy of the file.
' If you want to change the file name then change only TempFileName variable.
TempFilePath = Environ$("temp") & "\"
TempFileName = Range("I10").Value & " " & Range("B10") & " " & Format(Now, "dd-mmm-yy")
FileExtStr = "." & LCase(Right(wb1.Name, _
Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))


wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)


Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)


On Error Resume Next
' Change the mail address and subject in the macro before you run this procedure.
With OutMail
.To = Range("U23")
.CC = ""
.BCC = ""
.Subject = "Please check the attached trading fax"
.Body = ""
.Attachments.Add wb2.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Display
Application.Wait (Now + TimeValue("0:00:01"))
Application.SendKeys "%s"
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

Unload Me
End Sub

The problem I'm having is that the workbook Outlook sends is opened in protected view and when I click on "Enable editing" I get a Run Time Error 91: Object variable or With block variable not set. The problem disappears if in the Workbook open code I remove the "if" statement but I would like that code to run only on the initial workbook as it makes a userform pop up and this is not necessary for the person that gets the workbook via email.
One solution could be to disable protected view in the application settings but I would like, if possible, to solve the problem differently.

Thanks to everyone that will take his time to help me, of course any kind of suggestion on any other mistake will be very much appreciated.
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Replace this...
Code:
wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
[COLOR=darkblue]Set[/COLOR] wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

With this...
Code:
wb1.Worksheets.Copy [COLOR=green]'Copy worksheets as a new workbook[/COLOR]
[COLOR=darkblue]Set[/COLOR] wb2 = ActiveWorkbook
wb2.SaveAs TempFilePath & TempFileName & ".xlsx", FileFormat:=51

It copies the worksheets to a new workbook excluding your Workbook_Open code and UserForm.
 
Upvote 0
Thank you very much, this way, if I understood correctly, the file that will be sent will have no macro enabled, is that correct? This is unfortunately not what I'm looking for as the workbook contains other macros which I would like to keep enabled, the only thing I would like to avoid is that specific userform (frmTransactionAssistant) to open automatically in the workbook I'm sending via email...

Thank you for your help!
 
Upvote 0
Thank you very much, this way, if I understood correctly, the file that will be sent will have no macro enabled, is that correct? This is unfortunately not what I'm looking for as the workbook contains other macros which I would like to keep enabled, the only thing I would like to avoid is that specific userform (frmTransactionAssistant) to open automatically in the workbook I'm sending via email...

Thank you for your help!
This deletes the code in just the ThisWorkbook code module in wb2. Would that work for you?

Code:
wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
[COLOR=darkblue]Set[/COLOR] wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)
[B][COLOR=darkblue]With[/COLOR] wb2.VBProject.VBComponents("ThisWorkbook").CodeModule
    .DeleteLines 1, .CountOfLines
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR][/B]
 
Upvote 0
I guess that would work however I didn't manage to get the expected result...

This is how I edited the code based on your suggestion:

Code:
[/FONT][/COLOR]Private Sub cmdSend_Click()    Range("T23").Value = Me.cboProofer
    
    If Me.cboProofer.Value = "" Then
    Me.cboProofer.SetFocus
    MsgBox "Please select a person"
    Exit Sub
    End If


    On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")
    If oOutlook <> "Outlook" Then
    MsgBox ("Please open Outlook")
    Exit Sub
    End If
    
    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


    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 as a macro-enabled (. Xlsm) and then retry the macro.", vbInformation
            Exit Sub
        End If
    End If


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    ' Make a copy of the file.
    ' If you want to change the file name then change only TempFileName variable.
    TempFilePath = Environ$("temp") & "\"
    TempFileName = Range("I10").Value & " " & Range("B10") & " " & Format(Now, "dd-mmm-yy")
    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.VBProject.VBComponents("ThisWorkbook").CodeModule
    .DeleteLines 1, .CountOfLines
    End With


    Set OutApp = CreateObject("Outlook.Application")
    
    Set OutMail = OutApp.CreateItem(0)


    On Error Resume Next
   ' Change the mail address and subject in the macro before you run this procedure.
    With OutMail
        .To = Range("U23")
        .CC = ""
        .BCC = ""
        .Subject = "Please check the attached trading fax"
        .Body = ""
        .Attachments.Add wb2.FullName
        ' You can add other files by uncommenting the following line.
        '.Attachments.Add ("C:\test.txt")
        ' In place of the following statement, you can use ".Display" to
        ' display the mail.
        .Display
        Application.Wait (Now + TimeValue("0:00:01"))
        Application.SendKeys "%s"
    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
    
    Unload Me
End Sub [COLOR=#574123][FONT=system]

When opening the workbook outlook just sent I still get the same error and the code in "ThisWorkbook" is still there...

Any suggestion? Thank you very much
 
Upvote 0
Sorry. Add this one line.

Code:
wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)
With wb2.VBProject.VBComponents("ThisWorkbook").CodeModule
    .DeleteLines 1, .CountOfLines
End With
[B]wb2.Save[/B]
 
Upvote 0
Funny thing happened today: the file is on dropbox, from my home computer everything works fine while from my work computer on the file I send the code in "this workbook" is still there...how is that even possible???!

Tried several times with the same exact file which is on a shared location...
 
Upvote 0
Funny thing happened today: the file is on dropbox, from my home computer everything works fine while from my work computer on the file I send the code in "this workbook" is still there...how is that even possible???!

Tried several times with the same exact file which is on a shared location...

What file do you post at DropBox? The reason I ask is because the cmdSend_Click procedure creates a temporary copy of your file; strips the ThisWorkbook code; then emails the temporary file and deletes it. Your original file is not affected. So what file is posted on DropBox?
 
Upvote 0
The original one, what I meant to say is that the Workbook I open first is always the same and then from that workbook I run the cmdSend_Click...Yesterday and now I'm running it from my home pc and everything works fine, today I was running it from my office pc and the code you suggested didn't delete any code in thisworkbook.

Thanks for any suggestion you might have :)
 
Upvote 0

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top