mongoose
12-13-2019, 09:51 AM
I am trying to send some data to Excel from Word after an email is sent. I have the email and the rest of it working fine. Now, I am just trying to get the part with Excel working right.
PrivateSub btnGenerateEmail_Click()
'Instatiate Application Objects (using late binding)
Dim App AsObject
Dim Msg AsObject
Const olMailItem AsLong=0
'Declare Form Variables
Dim EmplName AsString: EmplName =Me.frmEmployeeName
Dim IncidentDesc AsString: IncidentDesc =Me.frmIncidentDescription
Dim EmplTrain AsString: EmplTrain =Me.frmEmployeeTraining
Dim FaceOnRack AsString: FaceOnRack =Me.frmFaceOnRack
Dim DrawingProb AsString: DrawingProb =Me.frmDrawingProblem
Dim JobNum AsString: JobNum =Me.frmJobNumber
Dim DrwNum AsString: DrwNum =Me.frmDrawingNumber
Dim FaceDesc AsString: FaceDesc =Me.frmFaceDescription
Dim Qty AsString: Qty =Me.frmQty
Dim StockOrNon AsString: StockOrNon =Me.frmStockOrNon
Dim FaceReplace AsString: FaceReplace =Me.frmFaceReplace
'Set Application Objects (using late binding)
Set App = CreateObject("Outlook.Application")
Set Msg = App.CreateItem(olMailItem)
'Data validation
If IsNull(EmplName)Or EmplName =""Then
MsgBox ("Please enter the employee's name."), vbCritical
ExitSub
EndIf
If IsNull(IncidentDesc)Or IncidentDesc =""Then
MsgBox ("Please describe how the face was broken."), vbCritical
ExitSub
EndIf
If IsNull(EmplTrain)Or EmplTrain =""Then
MsgBox ("Does the employee need more training to avoid these kind of incidents in the future?"), vbCritical
ExitSub
EndIf
If IsNull(FaceOnRack)Or FaceOnRack =""Then
MsgBox ("Was the already broken when on rack?"), vbCritical
ExitSub
EndIf
If IsNull(DrawingProb)Or DrawingProb =""Then
MsgBox ("Was the face scrapped because of an issue with the drawing/art?"), vbCritical
ExitSub
EndIf
If IsNull(JobNum)Or JobNum =""Then
MsgBox ("Please enter the job number or traveler number."), vbCritical
ExitSub
EndIf
If IsNull(DrwNum)Or DrwNum =""Then
MsgBox ("Please enter the drawing number."), vbCritical
ExitSub
EndIf
If IsNull(FaceDesc)Or FaceDesc =""Then
MsgBox ("Please enter a description of the face being scrapped."), vbCritical
ExitSub
EndIf
If IsNull(Qty)Or Qty =""Then
MsgBox ("Please enter the quantity being scrapped."), vbCritical
ExitSub
EndIf
If IsNull(StockOrNon)Or StockOrNon =""Then
MsgBox ("Is the face stock or non-stock?"), vbCritical
ExitSub
EndIf
If IsNull(FaceReplace)Or FaceReplace =""Then
MsgBox ("Does this face need to be replaced?"), vbCritical
ExitSub
EndIf
'Compose HTML Message Body
Dim HTMLContent AsString
HTMLContent ="<p style='font-family:Calibri; font-size:14px;'>This email is an autogenerated scrap face incident report.</p>" _
&"<table style='font-family:Calibri; font-size:14px;' width='75%' border='1' bordercolor='black' cellpadding='5'>" _
&"<tr><td width='65%'>Employee Name</td><td>"& EmplName &"</td></tr>" _
&"<tr><td>How was the face broken?</td><td>"& IncidentDesc &"</td></tr>" _
&"<tr><td>Does employee in question need more training to prevent future incidents?</td><td>"& EmplTrain &"</td></tr>" _
&"<tr><td>Was the face found on the rack already broken?</td><td>"& FaceOnRack &"</td></tr>" _
&"<tr><td>Was the face scrapped because of an issue with the drawing/art?</td><td>"& DrawingProb &"</td></tr>" _
&"<tr><td>Job/Traveler Number:</td><td>"& JobNum &"</td></tr>" _
&"<tr><td>Drawing Number:</td><td>"& DrwNum &"</td></tr>" _
&"<tr><td>Face Description:</td><td>"& FaceDesc &"</td></tr>" _
&"<tr><td>Quantity</td><td>"& Qty &"</td></tr>" _
&"<tr><td>Stock or Non-Stock</td><td>"& StockOrNon &"</td></tr>" _
&"<tr><td>Does this face need to be replaced?</td><td>"& FaceReplace &"</td></tr>" _
&"</table>"
'Construct the email, pass parameter values, & send the email
With Msg
.To="test@test.com"
.Subject ="Scrap Face Incident Report"
.HTMLBody = HTMLContent
.Display
'.Send
EndWith
'MAY NEED WORK
'Make sure the generated email is the active window
App.ActiveWindow.WindowState = olMaximized
'Application.Windows("Scrap Face Incident Report - Message (HTML)").Activate
'Create entry in scrap report
Dim ScrapReportFile AsString
ScrapReportFile ="\\jacksonville-dc\common\SOP's for JV\WIP\Jonathan\JG - How to Replace Scrapped Faces\Scrap List (Faces).xlsx"
'File exists
If Dir(ScrapReportFile)<>""Then
Dim ObjExcel AsObject, ObjWb AsObject, ObjWorksheet AsObject
Set ObjExcel = CreateObject("EXCEL.APPLICATION")
Set ObjWb = ObjExcel.Workbooks.Open(ScrapReportFile)
ObjExcel.Visible =True
With ObjWb.Worksheets(3)
Dim lastrow AsLong: lastrow =.Cells(.Rows.Count,"A").End(xlUp).Row
MsgBox (lastrow)
EndWith
'ObjWb.Worksheets(1).Range("A1") = "SOP Title: " & SOPTitle
'ObjWb.Worksheets(1).Range("F1") = "Date: " & Format(Now, "MM/dd/yyyy")
'ObjWb.Save
'ObjWb.Close
EndIf
'File does not exist; throw error
EndSub
On this section of code:
With ObjWb.Worksheets(3)Dim lastrow AsLong: lastrow =.Cells(.Rows.Count,"A").End(xlUp).Row
MsgBox (lastrow)
EndWith
I am trying to send the data gathered from the form and create a new row at the bottom of the sheet and then insert the data into specified columns. When I am doing the .Cells(.Rows.Count...etc I am getting an error: "Run-time error: '424' Object Required"
Any help would be appreciated!
PrivateSub btnGenerateEmail_Click()
'Instatiate Application Objects (using late binding)
Dim App AsObject
Dim Msg AsObject
Const olMailItem AsLong=0
'Declare Form Variables
Dim EmplName AsString: EmplName =Me.frmEmployeeName
Dim IncidentDesc AsString: IncidentDesc =Me.frmIncidentDescription
Dim EmplTrain AsString: EmplTrain =Me.frmEmployeeTraining
Dim FaceOnRack AsString: FaceOnRack =Me.frmFaceOnRack
Dim DrawingProb AsString: DrawingProb =Me.frmDrawingProblem
Dim JobNum AsString: JobNum =Me.frmJobNumber
Dim DrwNum AsString: DrwNum =Me.frmDrawingNumber
Dim FaceDesc AsString: FaceDesc =Me.frmFaceDescription
Dim Qty AsString: Qty =Me.frmQty
Dim StockOrNon AsString: StockOrNon =Me.frmStockOrNon
Dim FaceReplace AsString: FaceReplace =Me.frmFaceReplace
'Set Application Objects (using late binding)
Set App = CreateObject("Outlook.Application")
Set Msg = App.CreateItem(olMailItem)
'Data validation
If IsNull(EmplName)Or EmplName =""Then
MsgBox ("Please enter the employee's name."), vbCritical
ExitSub
EndIf
If IsNull(IncidentDesc)Or IncidentDesc =""Then
MsgBox ("Please describe how the face was broken."), vbCritical
ExitSub
EndIf
If IsNull(EmplTrain)Or EmplTrain =""Then
MsgBox ("Does the employee need more training to avoid these kind of incidents in the future?"), vbCritical
ExitSub
EndIf
If IsNull(FaceOnRack)Or FaceOnRack =""Then
MsgBox ("Was the already broken when on rack?"), vbCritical
ExitSub
EndIf
If IsNull(DrawingProb)Or DrawingProb =""Then
MsgBox ("Was the face scrapped because of an issue with the drawing/art?"), vbCritical
ExitSub
EndIf
If IsNull(JobNum)Or JobNum =""Then
MsgBox ("Please enter the job number or traveler number."), vbCritical
ExitSub
EndIf
If IsNull(DrwNum)Or DrwNum =""Then
MsgBox ("Please enter the drawing number."), vbCritical
ExitSub
EndIf
If IsNull(FaceDesc)Or FaceDesc =""Then
MsgBox ("Please enter a description of the face being scrapped."), vbCritical
ExitSub
EndIf
If IsNull(Qty)Or Qty =""Then
MsgBox ("Please enter the quantity being scrapped."), vbCritical
ExitSub
EndIf
If IsNull(StockOrNon)Or StockOrNon =""Then
MsgBox ("Is the face stock or non-stock?"), vbCritical
ExitSub
EndIf
If IsNull(FaceReplace)Or FaceReplace =""Then
MsgBox ("Does this face need to be replaced?"), vbCritical
ExitSub
EndIf
'Compose HTML Message Body
Dim HTMLContent AsString
HTMLContent ="<p style='font-family:Calibri; font-size:14px;'>This email is an autogenerated scrap face incident report.</p>" _
&"<table style='font-family:Calibri; font-size:14px;' width='75%' border='1' bordercolor='black' cellpadding='5'>" _
&"<tr><td width='65%'>Employee Name</td><td>"& EmplName &"</td></tr>" _
&"<tr><td>How was the face broken?</td><td>"& IncidentDesc &"</td></tr>" _
&"<tr><td>Does employee in question need more training to prevent future incidents?</td><td>"& EmplTrain &"</td></tr>" _
&"<tr><td>Was the face found on the rack already broken?</td><td>"& FaceOnRack &"</td></tr>" _
&"<tr><td>Was the face scrapped because of an issue with the drawing/art?</td><td>"& DrawingProb &"</td></tr>" _
&"<tr><td>Job/Traveler Number:</td><td>"& JobNum &"</td></tr>" _
&"<tr><td>Drawing Number:</td><td>"& DrwNum &"</td></tr>" _
&"<tr><td>Face Description:</td><td>"& FaceDesc &"</td></tr>" _
&"<tr><td>Quantity</td><td>"& Qty &"</td></tr>" _
&"<tr><td>Stock or Non-Stock</td><td>"& StockOrNon &"</td></tr>" _
&"<tr><td>Does this face need to be replaced?</td><td>"& FaceReplace &"</td></tr>" _
&"</table>"
'Construct the email, pass parameter values, & send the email
With Msg
.To="test@test.com"
.Subject ="Scrap Face Incident Report"
.HTMLBody = HTMLContent
.Display
'.Send
EndWith
'MAY NEED WORK
'Make sure the generated email is the active window
App.ActiveWindow.WindowState = olMaximized
'Application.Windows("Scrap Face Incident Report - Message (HTML)").Activate
'Create entry in scrap report
Dim ScrapReportFile AsString
ScrapReportFile ="\\jacksonville-dc\common\SOP's for JV\WIP\Jonathan\JG - How to Replace Scrapped Faces\Scrap List (Faces).xlsx"
'File exists
If Dir(ScrapReportFile)<>""Then
Dim ObjExcel AsObject, ObjWb AsObject, ObjWorksheet AsObject
Set ObjExcel = CreateObject("EXCEL.APPLICATION")
Set ObjWb = ObjExcel.Workbooks.Open(ScrapReportFile)
ObjExcel.Visible =True
With ObjWb.Worksheets(3)
Dim lastrow AsLong: lastrow =.Cells(.Rows.Count,"A").End(xlUp).Row
MsgBox (lastrow)
EndWith
'ObjWb.Worksheets(1).Range("A1") = "SOP Title: " & SOPTitle
'ObjWb.Worksheets(1).Range("F1") = "Date: " & Format(Now, "MM/dd/yyyy")
'ObjWb.Save
'ObjWb.Close
EndIf
'File does not exist; throw error
EndSub
On this section of code:
With ObjWb.Worksheets(3)Dim lastrow AsLong: lastrow =.Cells(.Rows.Count,"A").End(xlUp).Row
MsgBox (lastrow)
EndWith
I am trying to send the data gathered from the form and create a new row at the bottom of the sheet and then insert the data into specified columns. When I am doing the .Cells(.Rows.Count...etc I am getting an error: "Run-time error: '424' Object Required"
Any help would be appreciated!