Macro Help

shaunkaz

Board Regular
Joined
Jan 30, 2008
Messages
204
Hi I have 2 macro which work individualy but do not work as one, it just stops at the sub end before sending out an email can someone please help

Sub SAP_Imports_and_Reports()
'
' SAP_Imports_and_Reports Macro
' Macro recorded 21/06/2010 by SHAUN banks
'
'
'MESSAGE AT BEGINNING
var1 = MsgBox("Only authorised personel to import downloads from SAP. As well as importing the downloads this will also produce the manufacturing lates report. Do you still wish to continue ???", vbYesNo + vbCritical, "Schneider-Electric Manufacturing Order Book")

If var1 = vbNo Then

stopnow = True

Else
' OPEN UP DOWNLOADS

ChDir _
"J:\Manufacuring Daily Order Book 2008\Manufacturing Order Book Downloads"
Workbooks.Open Filename:= _
"J:\Manufacuring Daily Order Book 2008\Manufacturing Order Book Downloads\Open Order Report.xls"
Workbooks.Open Filename:= _
"J:\Manufacuring Daily Order Book 2008\Manufacturing Order Book Downloads\COIS Download.xls"
Workbooks.Open Filename:= _
"J:\Manufacuring Daily Order Book 2008\Manufacturing Order Book Downloads\Import FH30.xls"
Workbooks.Open Filename:= _
"J:\Manufacuring Daily Order Book 2008\Manufacturing Order Book Downloads\Open Deliveries Report.xls"

'Copy and paste downloads into core stock

'FH30

Windows("Manufacturing daily order book 2010.xls").Activate
Windows("Import FH30.xls").Activate
Cells.Select
Selection.Copy
Windows("Manufacturing daily order book 2010.xls").Activate
Sheets("Import FH30").Select
Cells.Select
ActiveSheet.Paste

'Coois

Windows("COIS Download.xls").Activate
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows("Manufacturing daily order book 2010.xls").Activate
Sheets("Import COOIS").Select
Cells.Select
ActiveSheet.Paste

'FH30 O.Orders

Sheets("FH 30 O.Orders").Select
Range("A2:S2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.ClearContents
Windows("Open Order Report.xls").Activate
Range("A2:S2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Manufacturing daily order book 2010.xls").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'FH30 O.Delivery

Sheets("FH 30 O.Delivery").Select
Range("A2:P2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.ClearContents
Windows("Open Deliveries Report.xls").Activate
Range("A2:P2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Manufacturing daily order book 2010.xls").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWindow.ScrollWorkbookTabs Position:=xlLast

'Update SAP report

Sheets("SAP").Select
Range("AI3:AK9007").Select
Selection.Copy
Range("A3").Select
Do While ActiveCell.Formula <> ""
ActiveCell.Offset(0, 1).Select
Loop
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Update Graphs

Sheets("graph data").Select
Range("a2:q3").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Update History

Sheets("O.Orders History").Select
Range("b2").Select
Do While ActiveCell.Formula <> ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, -1).Select
ActiveCell.Formula = Date

Sheets("FH 30 O.Orders").Select
Cells.Select
Selection.AutoFilter
Range("O3").Select
Selection.AutoFilter Field:=21, Criteria1:="Late"
Selection.AutoFilter Field:=22, Criteria1:="Manufacturing"
Range("A2:Ac2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Sheets("O.Orders History").Select
Range("b2").Select
Do While ActiveCell.Formula <> ""
ActiveCell.Offset(1, 0).Select
Loop


Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

' Close all SAP files

Windows("Open Order Report.xls").Activate
ActiveWindow.Close
Windows("COIS Download.xls").Activate
ActiveWindow.Close
Windows("Import FH30.xls").Activate
ActiveWorkbook.Close
Windows("Open Deliveries Report.xls").Activate
ActiveWindow.Close

'Back to Manufacturing Daily Order Book

Windows("Manufacturing daily order book 2010.xls").Activate

'Tidy up Pages

Range("A1").Select
ActiveSheet.Next.Select
Range("A1").Select
ActiveSheet.Next.Select
Range("D2").Select
ActiveSheet.Next.Select
Cells.Select
Selection.AutoFilter
Range("G2").Select
ActiveSheet.Next.Select
Range("A1").Select
ActiveSheet.Next.Select
Range("D2").Select
ActiveSheet.Next.Select
ActiveSheet.Next.Select
Range("A6").Select
ActiveSheet.Next.Select
Range("I6").Select
ActiveSheet.Next.Select
Range("J8").Select
ActiveSheet.Next.Select
Range("J7").Select
ActiveSheet.Next.Select
Range("F6").Select
ActiveSheet.Next.Select
Range("J8").Select
ActiveSheet.Next.Select
Range("A1").Select
ActiveSheet.Next.Select
Range("E2").Select
ActiveSheet.Next.Select
Range("D2").Select
ActiveSheet.Next.Select
Range("A8").Select
ActiveSheet.Previous.Select
ActiveSheet.Previous.Select
ActiveSheet.Previous.Select
ActiveSheet.Previous.Select
ActiveSheet.Previous.Select
ActiveSheet.Previous.Select
ActiveSheet.Previous.Select
ActiveSheet.Previous.Select
Range("A1").Select

'Save

ActiveWorkbook.Save

'Create Manufacturing Late report

Sheets("FH 30 O.Orders").Select
Cells.Select
Selection.AutoFilter
Range("S5").Select
Selection.AutoFilter Field:=21, Criteria1:="Late"
Selection.AutoFilter Field:=22, Criteria1:="Manufacturing"
Sheets("FH 30 O.Delivery").Select
Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=21, Criteria1:="Late"
Selection.AutoFilter Field:=22, Criteria1:="Manufacturing"

' Open blank Manufacturing Late Report

ChDir _
"J:\Manufacuring Daily Order Book 2008\Manufacturing Order Book Downloads"
Workbooks.Open Filename:= _
"J:\Manufacuring Daily Order Book 2008\Manufacturing Order Book Downloads\Late Report Manufacturing.xls"
Windows("Manufacturing daily order book 2010.xls").Activate

' Copy Files form FH30 O.Orders

Sheets("FH 30 O.Orders").Select
Range("A1:AC1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

'Paste FH30.Orders into Late report

Windows("Late Report Manufacturing.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Columns.AutoFit
Range("A1").Select
Windows("Manufacturing daily order book 2010.xls").Activate

'Copy FH30 O.Delivery for Late report

Sheets("FH 30 O.Delivery").Select
Range("A1:AA1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

'Paste FH30 Delivery into Late Report

Windows("Late Report Manufacturing.xls").Activate
Sheets("Late Open Deliveries").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Columns.AutoFit
Range("AB1").Select
Windows("Manufacturing daily order book 2010.xls").Activate
Selection.AutoFilter
Range("A1").Select
Sheets("FH 30 O.Orders").Select
Selection.AutoFilter
Range("G2").Select
Sheets("CURRENT").Select
Range("A2").Select
' Take a copy of Core stock and place intop the Core Stock hisory
Sheets("Core Stock History").Select
Range("E3:E1000").Select
Selection.Copy
Range("E3").Select
Do While ActiveCell.Formula <> ""
ActiveCell.Offset(0, 1).Select
Loop

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("a1").Select

Application.CutCopyMode = False

Sheets("CURRENT").Select
Range("a1").Select
ActiveWorkbook.Save

'Late report Save and Close

Windows("Late Report Manufacturing.xls").Activate
ActiveWorkbook.Save
ActiveWorkbook.Close

Windows("Manufacturing daily order book 2010.xls").Activate



End If

End Sub
'This next file will email the late reports - THIS IS WHERE IT STOPS AND WILL NOT CARRY ON

Sub Email1()
Dim oSess As Object
Dim oDB As Object
Dim oDoc As Object
Dim oItem As Object
Dim direct As Object
Dim Var As Variant
Dim flag As Boolean
Set oSess = CreateObject("Notes.NotesSession")
Set oDB = oSess.GETDATABASE("", "")
Call oDB.OPENMAIL
flag = True
If Not (oDB.IsOpen) Then flag = oDB.Open("", "")
If Not flag Then
MsgBox "Can't open mail file: " & oDB.SERVER & " " & oDB.FILEPATH
GoTo exit_SendAttachment
End If
On Error GoTo err_handler
'Building Message
Set oDoc = oDB.CREATEDOCUMENT
Set oItem = oDoc.CREATERICHTEXTITEM("BODY")
oDoc.Form = "Memo"
oDoc.Subject = "Manufacturing Late Report"
oDoc.sendto = "email address"
oDoc.body = ""
oDoc.postdate = Date
oDoc.SaveMessageOnSend = True
'Attaching DATABASE
Call oItem.EmbedObject(1454, "", "J:\Manufacuring Daily Order Book 2008\Manufacturing Order Book Downloads\Late Report Manufacturing.xls")
oDoc.visable = True
'Sending Message
oDoc.SEND False
exit_SendAttachment:
On Error Resume Next
Set oSess = Nothing
Set oDB = Nothing
Set oDoc = Nothing
Set oItem = Nothing
'Done
Exit Sub
err_handler:
If Err.Number = 7225 Then
MsgBox "File doesn't exist"
Else
MsgBox Err.Number & " " & Err.Description
End If
On Error GoTo exit_SendAttachment
End Sub



' Message box when finished


var1 = MsgBox("Imports Completed and Document Saved", vbOKOnly + vbInformation, "Thankyou")


End If


End Sub
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
At the moment it is 2 separate macros. You can either put Call Email1 at the end of the first macro to start the second or remove the following to make it continue.

Code:
End Sub
[B]'This next file will email the late reports - THIS IS WHERE IT STOPS AND WILL NOT CARRY ON[/B]

Sub Email1()
 
Upvote 0

Forum statistics

Threads
1,214,878
Messages
6,122,062
Members
449,064
Latest member
scottdog129

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