Log in

View Full Version : [SOLVED:] EXCEL to Word vb CODE



JonJon
11-12-2017, 09:33 AM
Can anyone help with the following code:

Sub GetFormData()
'Note: this code requires a reference to the Word object model
'To do this, go to Tools|References in the VBE, then scroll down to the Microsoft Word entry and check it.
Application.ScreenUpdating = False
Dim wdApp As New Word.Application, wdDoc As Word.Document, CCtrl As Word.ContentControl
Dim strFolder As String, strFile As String, WkSht As Worksheet, i As Long, j As Long
strFolder = GetFolder
If strFolder = "" Then Exit Sub
Set WkSht = ActiveSheet
i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
i = i + 1
Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
j = 0
For Each CCtrl In .ContentControls
With CCtrl
Select Case .Type
Case Is = wdContentControlCheckBox
j = j + 1
WkSht.Cells(i, j).Value = .Checked
Case wdContentControlDate, wdContentControlDropdownList, wdContentControlRichText, wdContentControlText
j = j + 1
WkSht.Cells(i, j).Value = .Range.Text
Case Else
End Select
End With
Next
.Close SaveChanges:=False
End With
strFile = Dir()
Wend
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
End Sub


Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

I need the script to insert the data into a single designated column. THe above code currently inserts all the data into the first available row.

macropod
11-12-2017, 02:56 PM
If there's only the one content control to extract data from in each document, you could change:

With wdDoc
j = 0
For Each CCtrl In .ContentControls
j = j + 1
WkSht.Cells(i, j) = CCtrl.Range.Text
Next
End With
to:
WkSht.Cells(i, 1) = wdDoc.ContentControls(2).Range.Text
where 1 is the column # you want to update and 2 is the content control # you want to extract the data from.

SamT
11-12-2017, 04:16 PM
Edit

WkSht.Cells(i, j)
To

WkSht.Cells(j, i)

macropod
11-12-2017, 04:25 PM
Edit

WkSht.Cells(i, j)
To

WkSht.Cells(j, i)
That really isn't going to satisfy the specified requirement:

I need the script to insert the data into a single designated column

SamT
11-12-2017, 06:58 PM
Each strFile gets it's own Column, Each CCtrl gets it's own Row in that Column.

What am I missing?

macropod
11-12-2017, 07:13 PM
The 'i' variable is updated for each new file, hence your variation would start at column # equivalent to the last-used row (which is what 'i' is initialized with) - if that column exists - then increments the column # for each new file. That is not inserting all the data into 'a single designated column', let alone (in all likelihood) an appropriate starting column. Either 'i' needs to be initialized with the column count (if the data are to go into separate columns) or, if there are multiple content controls and all the data are to go into the same column, the 'j' variable needs to be held constant and the 'i' value alone should be updated for each content control. The code revision I posted does that on the assumption there is only one content control to extract data from per file.

SamT
11-13-2017, 08:14 AM
Either 'i' needs to be initialized with the column count (if the data are to go into separate columns)
Those were my assumptions.

macropod
11-13-2017, 12:57 PM
Those were my assumptions.
But 'i' is still being initialized with the row count!

SamT
11-13-2017, 01:36 PM
I will change that in my workbook immediately.