"Microsoft Visual Basic: 400" in worksheet/ "Run-time error '1004'" in editor

Ruckus

New Member
Joined
Jun 7, 2011
Messages
15
Several users in the office are receiving "Microsoft Visual Basic: 400" errors when running the following macro within excel:

Code:
Sub Mail_workbook_Outlook_1()
'Working in 2000-2007
    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 be no VBA code in the file you send." & vbNewLine & _
                   "Save the 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 = "p:\"
 
    'Check if P: Drive exists else use c:
 
    If Dir("P:/temp/") <> "" Then ' To check if folder exist or not
        'MsgBox ("P: Drive exists!")
        TempFilePath = "P:\temp\"
    Else
        'MsgBox ("Will use C: Drive!")
        TempFilePath = "c:\temp\"
    End If
    TempFileName = IIf(Worksheets("User Set Up").Range("C10") <> "", Worksheets("User Set Up").Range("C10") & " " & Worksheets("User Set Up").Range("C11"), Worksheets("Winnipeg H-O Users").Range("C10") & " " & Worksheets("Winnipeg H-O Users").Range("C11")) & " User Setup Request" & " " & 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")
    'On Error Resume Next
    'OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
 
    On Error Resume Next
    With OutMail
         .To = ""
         .CC = ""
         .BCC = ""
         .Subject = IIf(Worksheets("User Set Up").Range("C10") <> "", Worksheets("User Set Up").Range("C10") & " " & Worksheets("User Set Up").Range("C11"), Worksheets("Winnipeg H-O Users").Range("C10") & " " & Worksheets("Winnipeg H-O Users").Range("C11")) & " User Setup Request"
         .Body = "The form is attached."
         .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
    wb1.Close SaveChanges:=False
End Sub

Is this something to do with the range I've set for the 'tempfilename' and '.subject' line?

Any ideas how to resolve this while still keeping the macro in tact?
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
What line of code specifically gives you the error?
What are the contents of the (important) variables at that moment?

At first sight the syntax is correct.
 
Upvote 0
I don't find any errors with the code on my PC, let me see if I can go debug it on one of the other PCs
 
Upvote 0
I get the error when reaching the highlighted line..

Code:
Sub Mail_workbook_Outlook_1()
'Working in 2000-2007
    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 be no VBA code in the file you send." & vbNewLine & _
                   "Save the 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 = "p:\"
 
    'Check if P: Drive exists else use c:
 
    If Dir("P:/temp/") <> "" Then ' To check if folder exist or not
        'MsgBox ("P: Drive exists!")
        TempFilePath = "P:\temp\"
    Else
        'MsgBox ("Will use C: Drive!")
        TempFilePath = "c:\temp\"
    End If
    TempFileName = IIf(Worksheets("User Set Up").Range("C10") <> "", Worksheets("User Set Up").Range("C10") & " " & Worksheets("User Set Up").Range("C11"), Worksheets("Winnipeg H-O Users").Range("C10") & " " & Worksheets("Winnipeg H-O Users").Range("C11")) & " User Setup Request" & " " & Format(Now, "dd-mmm-yy")
    FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
 
    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
    [COLOR=darkorange]Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)[/COLOR]
 
    Set OutApp = CreateObject("Outlook.Application")
    'On Error Resume Next
    'OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
 
    On Error Resume Next
    With OutMail
         .To = ""
         .CC = ""
         .BCC = ""
         .Subject = IIf(Worksheets("User Set Up").Range("C10") <> "", Worksheets("User Set Up").Range("C10") & " " & Worksheets("User Set Up").Range("C11"), Worksheets("Winnipeg H-O Users").Range("C10") & " " & Worksheets("Winnipeg H-O Users").Range("C11")) & " User Setup Request"
         .Body = "The form is attached."
         .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
    wb1.Close SaveChanges:=False
End Sub
 
Upvote 0
So, in the line above the error line, you save the active workbook. Fine.
Next line, you open the file again? What is the purpose of this line of code given that the file is already opened?
 
Upvote 0
I'm not sure to be honest, that code was there before I started working on this. I'll get rid of the second workbook and see what happens
 
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,140
Members
448,551
Latest member
Sienna de Souza

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