gmaxey
05-18-2017, 08:16 AM
I am not an Excel VBA programmer as the following will illustrate and hoping for a review by an expert for advice/best methods:
Objective: From within a Word document, export data from "titled" document content controls to an appended new row in an Excel worksheet. The target column in Excel as the same name (set in row 1) as the content control. Over time the content controls titles, column titles (or both) may change. There may or may not be an Excel column associated with each titled document CC.
Here is my code:
Sub Test()
AppendToExcel ActiveDocument
End Sub
Sub AppendToExcel(oDoc As Document)
Dim oApp As Object, oBook As Object, oSheet As Object
Dim bKillApp As Boolean
Dim oRngID As Object, oRngCol As Object, oRngRow As Object
Dim lngRow As Long
Dim oCC As ContentControl
On Error Resume Next
Set oApp = GetObject(, "Excel Application")
If oApp Is Nothing Then
bKillApp = True
'Set oApp = New Excel.Application
Set oApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set oBook = oApp.Workbooks.Open(oDoc.Path & "\Data.xlsx")
Set oSheet = oBook.Sheets(1)
'Is unique record ID already recorded?
Set oRngCol = oSheet.Columns(1)
On Error GoTo Err_Handler
Set oRngID = oRngCol.Find(oDoc.SelectContentControlsByTitle("ID").Item(1).Range.Text, oSheet.Cells(1))
If Not oRngID Is Nothing Then
lngRow = oRngID.Row
'Delete the current record
oSheet.Rows(lngRow).Delete
End If
'Append new record.
lngRow = oSheet.Cells(oSheet.Rows.Count, 1).End(-4162).Row + 1
For Each oCC In ActiveDocument.ContentControls
Set oRngRow = oSheet.Rows(1)
If Not oCC.Title = vbNullString Then
'Looking for the most efficent way to determine the correct column index to write data to.
Set oRngID = oRngRow.Find(oCC.Title, oSheet.Cells(1))
If Not oRngID Is Nothing Then
If Not oCC.ShowingPlaceholderText Then
oSheet.Cells(lngRow, oRngID.Column) = oCC.Range.Text
Else
oSheet.Cells(lngRow, oRngID.Column) = vbNullString
End If
End If
End If
Next oCC
oBook.Close wdSaveChanges
lbl_Exit:
If bKillApp Then oApp.Quit
Set oDoc = Nothing: Set oApp = Nothing: Set oBook = Nothing: Set oSheet = Nothing
Exit Sub
Err_Handler:
MsgBox Err.Number & " " & Err.Description
oBook.Close wdDoNotSaveChanges
Resume lbl_Exit
End Sub
As you see, I'm using "Find" to identify the Column index for the target data cell. Any tips or improvement or better method is appreciated.
Objective: From within a Word document, export data from "titled" document content controls to an appended new row in an Excel worksheet. The target column in Excel as the same name (set in row 1) as the content control. Over time the content controls titles, column titles (or both) may change. There may or may not be an Excel column associated with each titled document CC.
Here is my code:
Sub Test()
AppendToExcel ActiveDocument
End Sub
Sub AppendToExcel(oDoc As Document)
Dim oApp As Object, oBook As Object, oSheet As Object
Dim bKillApp As Boolean
Dim oRngID As Object, oRngCol As Object, oRngRow As Object
Dim lngRow As Long
Dim oCC As ContentControl
On Error Resume Next
Set oApp = GetObject(, "Excel Application")
If oApp Is Nothing Then
bKillApp = True
'Set oApp = New Excel.Application
Set oApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set oBook = oApp.Workbooks.Open(oDoc.Path & "\Data.xlsx")
Set oSheet = oBook.Sheets(1)
'Is unique record ID already recorded?
Set oRngCol = oSheet.Columns(1)
On Error GoTo Err_Handler
Set oRngID = oRngCol.Find(oDoc.SelectContentControlsByTitle("ID").Item(1).Range.Text, oSheet.Cells(1))
If Not oRngID Is Nothing Then
lngRow = oRngID.Row
'Delete the current record
oSheet.Rows(lngRow).Delete
End If
'Append new record.
lngRow = oSheet.Cells(oSheet.Rows.Count, 1).End(-4162).Row + 1
For Each oCC In ActiveDocument.ContentControls
Set oRngRow = oSheet.Rows(1)
If Not oCC.Title = vbNullString Then
'Looking for the most efficent way to determine the correct column index to write data to.
Set oRngID = oRngRow.Find(oCC.Title, oSheet.Cells(1))
If Not oRngID Is Nothing Then
If Not oCC.ShowingPlaceholderText Then
oSheet.Cells(lngRow, oRngID.Column) = oCC.Range.Text
Else
oSheet.Cells(lngRow, oRngID.Column) = vbNullString
End If
End If
End If
Next oCC
oBook.Close wdSaveChanges
lbl_Exit:
If bKillApp Then oApp.Quit
Set oDoc = Nothing: Set oApp = Nothing: Set oBook = Nothing: Set oSheet = Nothing
Exit Sub
Err_Handler:
MsgBox Err.Number & " " & Err.Description
oBook.Close wdDoNotSaveChanges
Resume lbl_Exit
End Sub
As you see, I'm using "Find" to identify the Column index for the target data cell. Any tips or improvement or better method is appreciated.