Review for Best Method

[gmaxey]

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.

[Paul_Hossler]

Just looking at the Excel side, maybe you could use something like this





Sub Demo()

Dim vMatch As Variant
Dim oNext As Range
Dim sCC As String

sCC = InputBox("The CC?", "Demo")

'assumes titles are in Row 1
vMatch = Application.Match("CC_TITLE", ActiveSheet.Rows(1), 0)

If Not IsError(vMatch) Then
'MsgBox vMatch

Set oNext = ActiveSheet.Cells(ActiveSheet.Rows.Count, vMatch).End(xlUp).Offset(1, 0)

oNext.Value = sCC

End If

End Sub

[gmaxey]

Paul,

Thanks. I got that to work for both determining if the record ID already exists and for writing to the titled column. I'm just tinkering at this stage. Do you see that change making much (if any) of a difference as far a execution speed?

[Paul_Hossler]

I wouldn't expect any perceptible performance improvement

[gmaxey]

Ok. Thanks for taking a look and for your replies.