ohiojarhead
New Member
- Joined
- Jan 23, 2014
- Messages
- 28
I would greatly appreciate any help on this as I am out of ideas. We have an application that is used to track inventory shortages. The app allows us to download the information into an excel sheet. The problem is that there is a lot of information in the app (designed for corporate level view) that is not necessary (workcenter view). Naturally I wrote a macro to process the workbook for me. Here is my code
This worked like a charm yesterday. Today I was given the additional task of having the report emailed to the buyers that have shortages that are missing the shipping info. I added this code from Ron de Bruin.
Now whenever I attempt to run this macro, I receive the following error:
Run-time error '1004':
Application-defined or object-defined error
As for the sheet, here is the header row and the first row of data (types):
<TBODY>
</TBODY>
I stepped through the code, and it appears to break in the Shortage_Macro during the first Print Setup. I have attempted to just run the Shortage_Macro and omitt the Send_Sheets_Notes_Email</SPAN></SPAN> and I receive the same error. Again, the Shortage_Macro ran just fine yesterday. Sorry for writing a short novel, but I did not want to waste anyones time by having them ask questions due to a lack of information.
Code:
Public Sub Shortage_Macro()</SPAN>
'Variables</SPAN>
'Turn off screen updating</SPAN>
Application.ScreenUpdating = False</SPAN>
'Re-name first worksheet</SPAN>
Sheets(1).Select</SPAN>
ActiveSheet.Name = "PartShortageBuyer"</SPAN>
'Delete Un-needed data</SPAN>
Range("A:A,G:K,O:Q,S:T,V:Y,AA:AI,AK:AV").Delete</SPAN>
'Change Waybill and PO to Number Format for proper display</SPAN>
Range("G:G").NumberFormat = "0"</SPAN>
Range("K:K").NumberFormat = "0"</SPAN>
'Align all data to the left</SPAN>
Range("A:L").HorizontalAlignment = xlLeft</SPAN>
'Create new sheet for shortages without shipping information</SPAN>
Sheets.Add After:=Sheets(Sheets.Count)</SPAN>
Sheets("Sheet1").Select</SPAN>
Sheets("Sheet1").Name = "MissingShippingInfo"</SPAN>
Sheets("PartShortageBuyer").Range("A1:L1").Copy</SPAN>
Sheets("MissingShippingInfo").Range("A1:L1").PasteSpecial</SPAN>
'Search for records missing shipping info and move them to the second sheet</SPAN>
Sheets("PartShortageBuyer").Activate</SPAN>
For i = 2 To Range("A2").End(xlDown).Row()</SPAN>
If Range("F" & i).Value = "" Or Range("G" & i).Value = "" Or Range("H" & i).Value = "" Then</SPAN>
Range("A" & i).EntireRow.Cut</SPAN>
Sheets("MissingShippingInfo").Activate</SPAN>
ActiveSheet.Range("A1").Select</SPAN>
ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).Select</SPAN>
ActiveSheet.Paste</SPAN>
End If</SPAN>
Next i</SPAN>
Sheets("MissingShippingInfo").Range("A1").Select</SPAN>
Sheets("PartShortageBuyer").Activate</SPAN>
Range("A1").Select</SPAN>
'Sort based on shortage</SPAN>
Columns("A:A").Select</SPAN>
ActiveWorkbook.Worksheets("PartShortageBuyer").Sort.SortFields.Clear</SPAN>
ActiveWorkbook.Worksheets("PartShortageBuyer").Sort.SortFields.Add Key:=Range _</SPAN>
("A2:A22"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _</SPAN>
xlSortNormal</SPAN>
With ActiveWorkbook.Worksheets("PartShortageBuyer").Sort</SPAN>
.SetRange Range("A1:L22")</SPAN>
.Header = xlYes</SPAN>
.MatchCase = False</SPAN>
.Orientation = xlTopToBottom</SPAN>
.SortMethod = xlPinYin</SPAN>
.Apply</SPAN>
End With</SPAN>
'Size columns for first tab</SPAN>
Sheets("PartShortageBuyer").Activate</SPAN>
Columns("A").ColumnWidth = 8.14</SPAN>
Columns("B").ColumnWidth = 5</SPAN>
Columns("C").ColumnWidth = 20</SPAN>
Columns("D").ColumnWidth = 7</SPAN>
Columns("E").ColumnWidth = 12.43</SPAN>
Columns("F").ColumnWidth = 14.29</SPAN>
Columns("G").ColumnWidth = 15</SPAN>
Columns("H").ColumnWidth = 14.43</SPAN>
Columns("I").ColumnWidth = 35</SPAN>
Columns("J").ColumnWidth = 7.86</SPAN>
Columns("K").ColumnWidth = 10.43</SPAN>
Columns("L").ColumnWidth = 12</SPAN>
ActiveWindow.DisplayGridlines = False</SPAN>
'Set borders</SPAN>
Range("A1").Select</SPAN>
ActiveCell.CurrentRegion.Select</SPAN>
Selection.Borders(xlDiagonalDown).LineStyle = xlNone</SPAN>
Selection.Borders(xlDiagonalUp).LineStyle = xlNone</SPAN>
With Selection.Borders</SPAN>
.LineStyle = xlContinuous</SPAN>
.Color = -1316633</SPAN>
.TintAndShade = 0</SPAN>
.Weight = xlThin</SPAN>
End With</SPAN>
'Format Header Row</SPAN>
Range("A1").Select</SPAN>
Range(Selection, Selection.End(xlToRight)).Select</SPAN>
With Selection.Interior</SPAN>
.Pattern = xlSolid</SPAN>
.PatternColorIndex = xlAutomatic</SPAN>
.Color = 6764288</SPAN>
.TintAndShade = 0</SPAN>
.PatternTintAndShade = 0</SPAN>
End With</SPAN>
With Selection.Font</SPAN>
.Color = -2896181</SPAN>
.TintAndShade = 0</SPAN>
End With</SPAN>
'Print Setup</SPAN>
ActiveSheet.PageSetup.PrintArea = Range("A1").CurrentRegion.Address</SPAN>
With ActiveSheet.PageSetup</SPAN>
.LeftMargin = Application.InchesToPoints(0.7)</SPAN>
.RightMargin = Application.InchesToPoints(0.7)</SPAN>
.TopMargin = Application.InchesToPoints(0.75)</SPAN>
.BottomMargin = Application.InchesToPoints(0.75)</SPAN>
.HeaderMargin = Application.InchesToPoints(0.3)</SPAN>
.FooterMargin = Application.InchesToPoints(0.3)</SPAN>
.PrintHeadings = False</SPAN>
.PrintGridlines = False</SPAN>
.PrintComments = xlPrintNoComments</SPAN>
.PrintQuality = 600</SPAN>
.CenterHorizontally = False</SPAN>
.CenterVertically = False</SPAN>
.Orientation = xlLandscape</SPAN>
.Draft = False</SPAN>
.PaperSize = xlPaperLetter</SPAN>
.FirstPageNumber = xlAutomatic</SPAN>
.Order = xlDownThenOver</SPAN>
.BlackAndWhite = False</SPAN>
.Zoom = False</SPAN>
.FitToPagesWide = 1</SPAN>
.PrintErrors = xlPrintErrorsDisplayed</SPAN>
.OddAndEvenPagesHeaderFooter = False</SPAN>
.DifferentFirstPageHeaderFooter = False</SPAN>
.ScaleWithDocHeaderFooter = True</SPAN>
.AlignMarginsHeaderFooter = True</SPAN>
End With</SPAN>
'Size columns for second tab</SPAN>
Sheets("MissingShippingInfo").Activate</SPAN>
Sheets("MissingShippingInfo").Columns("A").ColumnWidth = 8.14</SPAN>
Sheets("MissingShippingInfo").Columns("B").ColumnWidth = 5</SPAN>
Sheets("MissingShippingInfo").Columns("C").ColumnWidth = 20</SPAN>
Sheets("MissingShippingInfo").Columns("D").ColumnWidth = 7</SPAN>
Sheets("MissingShippingInfo").Columns("E").ColumnWidth = 12.43</SPAN>
Sheets("MissingShippingInfo").Columns("F").ColumnWidth = 14.29</SPAN>
Sheets("MissingShippingInfo").Columns("G").ColumnWidth = 15</SPAN>
Sheets("MissingShippingInfo").Columns("H").ColumnWidth = 14.43</SPAN>
Sheets("MissingShippingInfo").Columns("I").ColumnWidth = 35</SPAN>
Sheets("MissingShippingInfo").Columns("J").ColumnWidth = 7.86</SPAN>
Sheets("MissingShippingInfo").Columns("K").ColumnWidth = 10.43</SPAN>
Sheets("MissingShippingInfo").Columns("L").ColumnWidth = 12</SPAN>
ActiveWindow.DisplayGridlines = False</SPAN>
'Set borders</SPAN>
Sheets("MissingShippingInfo").Range("A1").Select</SPAN>
ActiveCell.CurrentRegion.Select</SPAN>
Selection.Borders(xlDiagonalDown).LineStyle = xlNone</SPAN>
Selection.Borders(xlDiagonalUp).LineStyle = xlNone</SPAN>
With Selection.Borders</SPAN>
.LineStyle = xlContinuous</SPAN>
.Color = -1316633</SPAN>
.TintAndShade = 0</SPAN>
.Weight = xlThin</SPAN>
End With</SPAN>
'Format Header Row</SPAN>
Sheets("MissingShippingInfo").Range("A1").Select</SPAN>
Sheets("MissingShippingInfo").Range(Selection, Selection.End(xlToRight)).Select</SPAN>
With Selection.Interior</SPAN>
.Pattern = xlSolid</SPAN>
.PatternColorIndex = xlAutomatic</SPAN>
.Color = 6764288</SPAN>
.TintAndShade = 0</SPAN>
.PatternTintAndShade = 0</SPAN>
End With</SPAN>
With Selection.Font</SPAN>
.Color = -2896181</SPAN>
.TintAndShade = 0</SPAN>
End With</SPAN>
'Print Setup</SPAN>
ActiveSheet.PageSetup.PrintArea = Range("A1").CurrentRegion.Address</SPAN>
With ActiveSheet.PageSetup</SPAN>
.LeftMargin = Application.InchesToPoints(0.7)</SPAN>
.RightMargin = Application.InchesToPoints(0.7)</SPAN>
.TopMargin = Application.InchesToPoints(0.75)</SPAN>
.BottomMargin = Application.InchesToPoints(0.75)</SPAN>
.HeaderMargin = Application.InchesToPoints(0.3)</SPAN>
.FooterMargin = Application.InchesToPoints(0.3)</SPAN>
.PrintHeadings = False</SPAN>
.PrintGridlines = False</SPAN>
.PrintComments = xlPrintNoComments</SPAN>
.PrintQuality = 600</SPAN>
.CenterHorizontally = False</SPAN>
.CenterVertically = False</SPAN>
.Orientation = xlLandscape</SPAN>
.Draft = False</SPAN>
.PaperSize = xlPaperLetter</SPAN>
.FirstPageNumber = xlAutomatic</SPAN>
.Order = xlDownThenOver</SPAN>
.BlackAndWhite = False</SPAN>
.Zoom = False</SPAN>
.FitToPagesWide = 1</SPAN>
.PrintErrors = xlPrintErrorsDisplayed</SPAN>
.OddAndEvenPagesHeaderFooter = False</SPAN>
.DifferentFirstPageHeaderFooter = False</SPAN>
.ScaleWithDocHeaderFooter = True</SPAN>
.AlignMarginsHeaderFooter = True</SPAN>
End With</SPAN>
'Notify Buyers of records missing SHipping info</SPAN>
'Tidy up</SPAN>
Sheets("MissingShippingInfo").Range("A1").Select</SPAN>
Sheets("PartShortageBuyer").Activate</SPAN>
Range("A1").Select</SPAN>
Application.ScreenUpdating = True</SPAN>
End Sub
Code:
Public Sub Send_Sheets_Notes_Email()</SPAN>
'Notes parameter for attaching the Excel files.</SPAN>
Const EMBED_ATTACHMENT As Long = 1454</SPAN>
'A folder to temporarily store the created Excel files in.</SPAN>
Const stPath As String = "c:\temp"</SPAN>
'The subject for the outgoing e-mails.</SPAN>
Const stSubject As String = "Shortage Report - Missing Shipping Data"</SPAN>
'The message in the bodies of the outgoing e-mails.</SPAN>
Const vaMsg As Variant = "Please review the attached spreadsheet for the missing data and then update the shortage app." & vbCrLf & _</SPAN>
"[URL]https://www.google.com[/URL]" & vbCrLf & _</SPAN>
"" & vbCrLf & _</SPAN>
"" & vbCrLf & _</SPAN>
"Respectfully," & vbCrLf & _</SPAN>
"Name"</SPAN>
'Variable that holds the list of recipients for each worksheet.</SPAN>
Dim vaRecipients As Variant</SPAN>
'Variable which holds each worksheet's name.</SPAN>
Dim stFileName As String</SPAN>
'Variables for Notes.</SPAN>
Dim noSession As Object</SPAN>
Dim noDatabase As Object</SPAN>
Dim noDocument As Object</SPAN>
Dim noEmbedObject As Object</SPAN>
Dim noAttachment As Object</SPAN>
Dim stAttachment As String</SPAN>
'Variables for Excel.</SPAN>
Dim wbBook As Workbook</SPAN>
Dim wsSheet As Worksheet</SPAN>
Dim lnLastRow As Long</SPAN>
On Error GoTo Error_Handling</SPAN>
Application.ScreenUpdating = False</SPAN>
Set wbBook = ThisWorkbook</SPAN>
'Copy the worksheet to a new workbook.</SPAN>
Worksheets("MissingShippingInfo").Copy</SPAN>
'Retrieve the worksheet's name.</SPAN>
stFileName = Worksheets("MissingShippingInfo").Name</SPAN>
'Create the full path and name of the workbook.</SPAN>
stAttachment = stPath & "\" & stFileName & ".xls"</SPAN>
'Save and close the temporarily workbook.</SPAN>
With ActiveWorkbook</SPAN>
.SaveAs stAttachment</SPAN>
.Close</SPAN>
End With</SPAN>
'Retrieve the list of recipients.</SPAN>
With wsSheet</SPAN>
lnLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row</SPAN>
vaRecipients = .Range("L2:L" & lnLastRow).Value</SPAN>
End With</SPAN>
'Instantiate the Lotus Notes COM's Objects.</SPAN>
Set noSession = CreateObject("Notes.NotesSession")</SPAN>
Set noDatabase = noSession.GETDATABASE("", "")</SPAN>
'If Lotus Notes is not open then open the mail-part of it.</SPAN>
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL</SPAN>
'Create the e-mail and add the attachment.</SPAN>
Set noDocument = noDatabase.CreateDocument</SPAN>
Set noAttachment = noDocument.CreateRichTextItem("stAttachment")</SPAN>
Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)</SPAN>
'Add values to the created e-mail main properties.</SPAN>
With noDocument</SPAN>
.Form = "Memo"</SPAN>
.SendTo = vaRecipients</SPAN>
.Subject = stSubject</SPAN>
.Body = vaMsg</SPAN>
.SaveMessageOnSend = True</SPAN>
.PostedDate = Now()</SPAN>
.Send 0, vaRecipients</SPAN>
End With</SPAN>
'Delete the temporarily workbook.</SPAN>
Kill stAttachment</SPAN>
MsgBox ("The e-mails have successfully been created and distributed."), vbInformation</SPAN>
ExitSub:</SPAN>
'Release objects from memory.</SPAN>
Set noEmbedObject = Nothing</SPAN>
Set noAttachment = Nothing</SPAN>
Set noDocument = Nothing</SPAN>
Set noDatabase = Nothing</SPAN>
Set noSession = Nothing</SPAN>
Exit Sub</SPAN>
Error_Handling:</SPAN>
MsgBox "Error number: " & Err.Number & vbNewLine & _</SPAN>
"Description: " & Err.Description, vbOKOnly</SPAN>
Resume ExitSub</SPAN>
End Sub</SPAN>
Run-time error '1004':
Application-defined or object-defined error
As for the sheet, here is the header row and the first row of data (types):
Shortage | Plt | Part Number Short | Config | Delivery Date | Carrier | Waybill | Transport Mode | Vendor | AC Short | PO Req Nbr | Buyer User Id |
Gen | Gen | Gen | Gen | Date | Gen | Num | Gen | Gen | Gen | Num | Gen |
<TBODY>
</TBODY>
I stepped through the code, and it appears to break in the Shortage_Macro during the first Print Setup. I have attempted to just run the Shortage_Macro and omitt the Send_Sheets_Notes_Email</SPAN></SPAN> and I receive the same error. Again, the Shortage_Macro ran just fine yesterday. Sorry for writing a short novel, but I did not want to waste anyones time by having them ask questions due to a lack of information.