Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 06-04-2023, 11:37 AM
gmaxey gmaxey is offline Extract data form one Excel file to another Windows 10 Extract data form one Excel file to another Office 2019
Expert
Extract data form one Excel file to another
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,422
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default Extract data form one Excel file to another

Hi,



I don't post here often and I work primarily with Word and Word VBA, but occasionally need a bit of help with Excel. In this case, it might be a lot of help.


I have an existing process where I have a Word document form with content controls where the content control titles serve as column headings in a separate Excel file. Several Word forms are completed each day and the at the end of the day, I run a procedure in an Excel file where the the data in each completed Word form is extracted and saved as a new record in the Excel file. All works well.


I would like to expand my process where I have an Excel spreadsheet embedded within the Word document and data entered into the embedded Excel spreadsheet is also extracted.


Can anyone offer any tips or code on how this might be achieved?


Thank you.
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #2  
Old 06-07-2023, 04:27 PM
Guessed's Avatar
Guessed Guessed is offline Extract data form one Excel file to another Windows 10 Extract data form one Excel file to another Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,932
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

Greg

I did a google search and found some relevant code by Andy Pope which works in Word to read or write to its own embedded spreadsheet.
Code:
Sub WriteToSS()
  'Sourced from...
  'https://social.msdn.microsoft.com/Forums/en-US/c4969934-0a4a-4e2c-bb56-cf05f756dc82/can-you-use-vba-to-access-a-spread-sheet-embedded-in-a-word-doc?forum=isvvba
  ' added a couple of lines to read cell values and save any changes
  Dim objSS As InlineShape
  With ActiveDocument.InlineShapes(1)
    .OLEFormat.DoVerb wdOLEVerbHide
    With .OLEFormat.Object.Application
        With .Workbooks(1).Worksheets(1)
          Debug.Print .Cells(1, 1).Value, .Range("B1").Value  'reading cells
          .Cells(1, 1).Value = "Hello"  'writing to a cell
          .Range("B1").Value = "Big Boy"    'writing to another cell
        End With
        .Workbooks(1).Save  'if you wanted to save the changed cell values
        .Quit
    End With
  End With
End Sub
If you are already running code from Excel to access that Word document then you've got that part of the automation running and can adapt the relevant lines above into your existing code.
Getting the right InlineShape might be a bit tricky and relying on its numerical position in the document is problematic so I would probably use Format Object to set its Alt Text to a unique value so the code could iterate through all the InlineShapes to find the one which has that Alt Text value. An example of looping through a docs Shapes (same for InlineShapes) is shown in this thread.
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #3  
Old 06-07-2023, 05:14 PM
gmaxey gmaxey is offline Extract data form one Excel file to another Windows 10 Extract data form one Excel file to another Office 2019
Expert
Extract data form one Excel file to another
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,422
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

Andrew,

Thanks for the reply. I'm sorry I didn't get back here last night to update this thread. I had cobbled together something that seemed to work and was so excited about it, I forgot :-(

In my main routing which opens the Word document containing the embedded Excel file, I run this code:

Code:
'Get the embedded data

arrLabs = fcnGetEmbeddedLabData(oDoc)
'Set the target worksheet

Set oSheet = Worksheets("Labs")
'Get target range (last row)

lngLastRow = oSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
'Write the extracted values

oSheet.Cells(lngLastRow, "A").Resize(1, UBound(arrLabs) + 1).Value = arrLabs
'...
'More code to close the Word doc and process next doc.


Function fcnGetEmbeddedLabData(oDocPassed As Object) As String()
'Returns values in last column of embedded worksheet to a array.

Dim oILS As InlineShape
Dim oWS As Worksheet
Dim oWB As Workbook
Dim lngRow As Long, lngCol As Long
Dim lngRows As Long
Dim arrData() As String
  ReDim arrData(287)
  For Each oILS In oDocPassed.InlineShapes
    If oILS.Type = wdInlineShapeEmbeddedOLEObject Then
      If oILS.OLEFormat.progID = "Excel.Sheet.12" Then
        oILS.OLEFormat.Edit
        Set oWB = Workbooks(2)
        Set oWS = oWB.Sheets(1)
        lngCol = oWS.Cells(2, oWS.Columns.Count).End(xlToLeft).Column
        lngRows = oWS.Cells(Rows.Count, "A").End(xlUp).Row
        arrData(0) = oDocPassed.SelectContentControlsByTitle(strCCUnique).Item(1).Range.Text
        For lngRow = 1 To lngRows
          Select Case oWS.Cells(lngRow, lngCol).Text
            Case Is = "#DIV/0!", "#NUM!", "#VALUE!"
            Case Else
              arrData(lngRow) = oWS.Cells(lngRow, lngCol).Text
          End Select
        Next lngRow
      End If
    End If
  Next oILS
  fcnGetEmbeddedLabData = arrData()
  
lbl_Exit:
  Set oWB = Nothing: Set oWS = Nothing
  Exit Function
End Function

This seems to work nicely. Will look at your example in more detail. Thanks again.
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #4  
Old 06-07-2023, 07:27 PM
Guessed's Avatar
Guessed Guessed is offline Extract data form one Excel file to another Windows 10 Extract data form one Excel file to another Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,932
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

Looks like you already have it sorted. I will make a few minor suggestions to tidy it up a bit

1. Why redim the array if you already know how many slots
Code:
Dim arrData(287) As String
2. I'm surprised the workbook opens in the same Excel application instance but it seems a little haphazard to rely on it always being the second workbook. Is it worth exploring whether it is possible to be more explicit about which workbook is oWB?
Code:
Set oWB = oILS.OLEFormat.Object  'does this work
3. You can avoid the Select Case complexity if you make use of the worksheet function to return an empty string on errored formulas
Code:
For lngRow = 1 To lngRows
    arrData(lngRow) = WorksheetFunction.IfError(Cells(lngRow, lngCol), "")
  Next lngRow
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #5  
Old 06-08-2023, 03:46 AM
gmaxey gmaxey is offline Extract data form one Excel file to another Windows 10 Extract data form one Excel file to another Office 2019
Expert
Extract data form one Excel file to another
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,422
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

Andrew, thanks for the additional comments and help. It is always nice to have an expert on staff


Good point about fixed value for array dimension. Setting the worksheet to the OLE.Object also works.

Had troubles eliminating the Select Case complexity though.

Here is the new code:

Code:
Function fcnGetEmbeddedLabData(oDocPassed As Object) As String()
Dim oILS As InlineShape
Dim oWS As Worksheet
Dim oWB As Workbook
Dim lngRow As Long, lngCol As Long
Dim lngRows As Long
Dim arrData() As String
  For Each oILS In oDocPassed.InlineShapes
    If oILS.Type = wdInlineShapeEmbeddedOLEObject Then
      If oILS.OLEFormat.progID = "Excel.Sheet.12" Then
        oILS.OLEFormat.Edit
        'Set oWB = Workbooks(2)
        Set oWB = oILS.OLEFormat.Object
        Set oWS = oWB.Sheets(1)
        lngCol = oWS.Cells(2, oWS.Columns.Count).End(xlToLeft).Column
        lngRows = oWS.Cells(Rows.Count, "A").End(xlUp).Row
        ReDim arrData(lngRows)
        arrData(0) = oDocPassed.SelectContentControlsByTitle(strCCUnique).Item(1).Range.Text
        For lngRow = 1 To lngRows
          'If Not oWS.Cells(lngRow, lngCol).Text = vbNullString Then
            'arrData(lngRow) = WorksheetFunction.IfError(oWS.Cells(lngRow, lngCol), "")
          'End If
          Select Case oWS.Cells(lngRow, lngCol).Text
            Case Is = "#DIV/0!", "#NUM!", "#VALUE!"
            Case Else
              arrData(lngRow) = oWS.Cells(lngRow, lngCol).Text
          End Select
        Next lngRow
      End If
    End If
  Next oILS
  fcnGetEmbeddedLabData = arrData()
lbl_Exit:
  Set oWB = Nothing: Set oWS = Nothing
  Exit Function
End Function

If I stet out the Select Case stuff and use just your suggestion, then 1) The dates appeared in the extracted data as long values and 2) Many of the fields in the embedded sheet were extracted as "0"


If I wrapped your suggested line in the IF ... End If statement, that resolves the "0" issue, but not the long values for dates.


Any ideas? Thanks.
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #6  
Old 06-08-2023, 04:26 AM
gmaxey gmaxey is offline Extract data form one Excel file to another Windows 10 Extract data form one Excel file to another Office 2019
Expert
Extract data form one Excel file to another
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,422
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

Andrew,


Monkey learns! I figured out how to employ your IsError function without affecting the date values:

Code:
Function fcnGetEmbeddedLabData(oDocPassed As Object) As String()
Dim oILS As InlineShape
Dim oWS As Worksheet
Dim oWB As Workbook
Dim lngRow As Long, lngCol As Long
Dim lngRows As Long
Dim arrData() As String
  For Each oILS In oDocPassed.InlineShapes
    If oILS.Type = wdInlineShapeEmbeddedOLEObject Then
      If oILS.OLEFormat.progID = "Excel.Sheet.12" Then
        oILS.OLEFormat.Edit
        'Set oWB = Workbooks(2)
        Set oWB = oILS.OLEFormat.Object
        Set oWS = oWB.Sheets(1)
        lngCol = oWS.Cells(2, oWS.Columns.Count).End(xlToLeft).Column
        lngRows = oWS.Cells(Rows.Count, "A").End(xlUp).Row
        ReDim arrData(lngRows)
        arrData(0) = oDocPassed.SelectContentControlsByTitle(strCCUnique).Item(1).Range.Text
        For lngRow = 1 To lngRows
          If WorksheetFunction.IsFormula(oWS.Cells(lngRow, lngCol)) Then
            arrData(lngRow) = WorksheetFunction.IfError(oWS.Cells(lngRow, lngCol), "")
          Else
            arrData(lngRow) = oWS.Cells(lngRow, lngCol).Text
          End If
'          Select Case oWS.Cells(lngRow, lngCol).Text
'            Case Is = "#DIV/0!", "#NUM!", "#VALUE!"
'            Case Else
'              arrData(lngRow) = oWS.Cells(lngRow, lngCol).Text
'          End Select
        Next lngRow
      End If
    End If
  Next oILS
  fcnGetEmbeddedLabData = arrData()
lbl_Exit:
  Set oWB = Nothing: Set oWS = Nothing
  Exit Function
End Function
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Extract data from a Word file. donlincolnmsof Word VBA 3 08-31-2019 05:27 AM
Extract data from HTML File. donlincolnmsof Word VBA 5 08-26-2019 08:36 PM
Extract data from HTML File. donlincolnmsof Word VBA 0 03-07-2019 12:17 PM
Outlook 2013 Forms (how to questions)- Quick opening of a form file & Linking form's data to Excel gamin2407 Outlook 0 01-21-2017 10:14 PM
Macro to highlight repeated words in word file and extract into excel file aabri Word VBA 1 06-14-2015 07:20 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 04:09 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft