EXCEL to Word vb CODE

Can anyone help with the following code:

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.

If there's only the one content control to extract data from in each document, you could change:

Code:

---

        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.

Edit

Code:

---

WkSht.Cells(i, j)

---

To

Code:

---

WkSht.Cells(j, i)

---

Quote:

---

Originally Posted by SamT

Edit

Code:

---

WkSht.Cells(i, j)

---

To

Code:

---

WkSht.Cells(j, i)

---

---

That really isn't going to satisfy the specified requirement:

Quote:

---

Originally Posted by JonJon

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

---

Each strFile gets it's own Column, Each CCtrl gets it's own Row in that Column.

What am I missing?

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.

Quote:

---

Either 'i' needs to be initialized with the column count (if the data are to go into separate columns)

---

Those were my assumptions.

Quote:

---

Originally Posted by SamT

Those were my assumptions.

---

But 'i' is still being initialized with the row count!

I will change that in my workbook immediately.