Consulting

Results 1 to 2 of 2

Thread: Sending Data from Word Into Excel

  1. #1
    VBAX Regular
    Joined
    Jul 2019
    Posts
    51
    Location

    Sending Data from Word Into Excel

    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!

  2. #2
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    If Dir(ScrapReportFile)<>"" Then
       with getobject(ScrapReportFile)
          with .sheets(3).cells(rows.count,1).end(-4162).offset(1)
            .value= "SOP Title: " & SOPTitle
            .offset(,5)= "Date: " & Format(Date, "MM/dd/yyyy")
          end with
          .close -1
       end with
    End if

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •