I have an application in which I am automating Excel from Word where the
application opens a series of Word documents that are protected for filling
in forms and takes information from the formfields in each document and then
populates cells in an Excel Worksheet that the application creates from an
Excel Template (as well as inserting some of the information into a Word
document). After the Excel spreadsheet has been populated with all of the
required information, it is desired that the range of cells containing that
information be sorted on the data in one of the columns.

The only way that I have been able to do the sort is to use

Set xlrange = tSheet.Range("A11:T" & j - 1)
xlrange.Select
oXL.SendKeys "%a%a"

As the use of SendKeys seems to suffer the same reliability problems in
Excel as it does in Word (though sometimes, it appears that it is necessary
to resort to it), I would like to try and avoid using it.

If I run the following code from Excel itself, on a Worksheet that contains
three rows of data (rows 11, 12 and 13 - Hence j -1 = 13), the sort is
performed:

Dim tsheet As Worksheet
Set tsheet = ActiveWorkbook.ActiveSheet
Dim j As Long
j = 14
tsheet.Sort.SortFields. _
Clear
tsheet.Sort.SortFields. _
Add Key:=Range("A11"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With tsheet.Sort
.SetRange Range("A11:T" & j - 1)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

It does not however work when used in the following code. Does anyone know
how what I should use in the following code to do the sorting.

Dim fname As String
Dim PathToUse As String
Dim oXL As Excel.Application
Dim ETarget As Excel.Workbook
Dim WTarget As Document
Dim Source As Document
Dim fd As FileDialog
Dim drange As Range
Dim strText As String
Dim i As Long, j As Long
Dim tSheet As Excel.Worksheet
Dim ResidentName As String
Dim xlrange As Excel.Range

'If Excel is running, get a handle on it; otherwise start a new instance of
Excel
On Error Resume Next
Set oXL = GetObject(, "Excel.Application")

If Err Then
Set oXL = CreateObject("Excel.Application")
End If
'Allow the user to select the folder containing the Word files to be
processed
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "Select the folder containing the files."
If .Show = -1 Then
PathToUse = .SelectedItems(1) & "\"
Else
End If
End With
Set fd = Nothing
oXL.Visible = True
'Create a new workbook from the LongSheet template
Set ETarget = oXL.Workbooks.Add(ThisDocument.Path & "\LongSheet.xlt")
Set tSheet = ETarget.Sheets(1)
tSheet.Activate
'Create a new Word document from the Daily Report template
Set WTarget = Documents.Add("Daily Report.dot")
If Len(PathToUse) = 0 Then
Exit Sub
End If
fname = Dir$(PathToUse & "*.doc*")
'Set the first row of the spreadsheet into which data is to be inserted
j = 11
'Open each document and extract the data from the formfields to populate the
spreadsheet and the Word document
While fname < ""
Set Source = Documents.Open(PathToUse & fname)
With Source
ResidentName = .FormFields("ResidentName").Result
ResidentName = Mid(ResidentName, InStr(ResidentName, ",") + 1) & " "
& Left(ResidentName, InStr(ResidentName, ",") - 1)
Set drange = WTarget.Tables(2).Cell(3, 3).Range
drange.End = drange.End - 1
drange.Collapse wdCollapseEnd
drange.InsertAfter .FormFields("MapNumber").Result _
& " " & ResidentName & vbCr
tSheet.Range("A" & j) = .FormFields("MapNumber").Result
tSheet.Range("C" & j) = .FormFields("Location").Result
tSheet.Range("D" & j) = ResidentName
tSheet.Range("E" & j) = .FormFields("Contact").Result
tSheet.Range("F" & j) = ResidentName & vbLf & _
.FormFields("Address1").Result & vbLf & _
.FormFields("Address2").Result
tSheet.Range("G" & j) = .FormFields("Phone").Result
tSheet.Range("H" & j) = .FormFields("ContactDate").Result
tSheet.Range("I" & j) = .FormFields("ContactDate").Result
tSheet.Range("J" & j) = .FormFields("DEPC").Result
j = j + 1
End With
Source.Close wdDoNotSaveChanges
fname = Dir$()
Wend
'Sort the data in the spreadsheet
'This does not sort the worksheet
' tSheet.Sort.SortFields. _
' Clear
' tSheet.Sort.SortFields. _
' Add Key:=Range("A11"), SortOn:=xlSortOnValues, Order:=xlAscending,
_
' DataOption:=xlSortNormal
' With tSheet.Sort
' .SetRange Range("A11:T" & j - 1)
' .Header = xlNo
' .MatchCase = False
' .Orientation = xlTopToBottom
' .SortMethod = xlPinYin
' .Apply
' End With
'This does sort the worksheet
Set xlrange = tSheet.Range("A11:T" & j - 1)
xlrange.Select
oXL.SendKeys "%a%a"
'Sort the information in the Word document
Set drange = WTarget.Tables(2).Cell(3, 3).Range
drange.End = drange.End - 1
drange.Sort ExcludeHeader:=False, FieldNumber:="Paragraphs", _
SortFieldType:=wdSortFieldNumeric, SortOrder:=wdSortOrderAscending

Set drange = Nothing
Set tSheet = Nothing
Set ETarget = Nothing
Set WTarget = Nothing
Set Target = Nothing
Set oXL = Nothing


--
Thanks and Regards

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com