Macro works in workbook created in, not in other

bombergirl61

New Member
Joined
Nov 19, 2014
Messages
7
Hi

I have been using the below macro in a work book for a while and it works fine, I have now saved the macro into my personal workbook to use on other identical workbooks and I receive an error code 9. when I debug it highlights the duedate format, Any assistance greatly appreciated
Rich (BB code):
Sub Z_Mail_SHEET_BUY_all()

'Working in Excel 2000-2016

'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm

Dim sh As Worksheet

Dim wb As Workbook

Dim FileExtStr As String

Dim FileFormatNum As Long

Dim TempFilePath As String

Dim TempFileName As String

Dim OutApp As Object

Dim OutMail As Object

Dim DueDate As String

DueDate = Format(ThisWorkbook.Sheets("National").Range("ad1").Value, "dd-mmm-yyyy")



TempFilePath = Environ$("temp") & "\"



If Val(Application.Version) < 12 Then

'You use Excel 97-2003

FileExtStr = ".xls": FileFormatNum = -4143

Else

'You use Excel 2007-2016

FileExtStr = ".xlsm": FileFormatNum = 52

End If



With Application

.ScreenUpdating = False

.EnableEvents = False

End With



Set OutApp = CreateObject("Outlook.Application")



For Each sh In ThisWorkbook.Worksheets

If sh.Range("A1").Value Like "?*@?*.?*" Then



sh.Copy

Set wb = ActiveWorkbook



TempFileName = "Sheet " & sh.Name & " of " _

& ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")



Set OutMail = OutApp.CreateItem(0)



With wb

.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum



On Error Resume Next

With OutMail

.to = sh.Range("A1").Value

.CC = ""

.BCC = ""

.Subject = "SHEET REQUIREMENTS"

.Body = "Hello" & vbNewLine & "Sheet purchase " & vbNewLine & "Please complete Column M with your requirements," & vbNewLine & "Return by " & DueDate & vbNewLine & "I will return with mill offers for your persual" & vbNewLine & "" & vbNewLine & "" & vbNewLine & "Cheers" & vbNewLine & "Cheryl"



.Attachments.Add wb.FullName

'You can add other files also like this

'.Attachments.Add ("C:\test.txt")

.Send 'or use .Display

End With

On Error GoTo 0



.Close savechanges:=False

End With



Set OutMail = Nothing



Kill TempFilePath & TempFileName & FileExtStr



End If

Next sh



Set OutApp = Nothing



With Application

.ScreenUpdating = True

.EnableEvents = True

End With

End Sub
 
Last edited by a moderator:

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
DueDate = Format(ActiveWorkbook.Sheets("National").Range("ad1").Value, "dd-mmm-yyyy")
 
Upvote 0
Solution

Forum statistics

Threads
1,212,938
Messages
6,110,782
Members
448,297
Latest member
carmadgar

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