Reverse Loop 1

[vicky666]

Hey All

The following code loops around and takes all the selected values from a list box and places them into a word document at a certain breakpoint. (this all works)

Naturally the code starts from the lowest number, and works it's way up. This causes a problem, as when the data is transferred to word, the numbers are in a descending order, but I would ideally like them in an ascending order

For example

10 Tim Roth
6 Max Power
1 Homer Simpson

But I'd like to be able to display them....

1 Homer Simpson
6 Max Power
10 Tim Roth


I'm sure I've done soemthing like this before but I'm at a loss, any help will be greatly appreciated thanks


The code is as follows..

Private Sub Merge()

On Error GoTo ErrorHandler

Dim ctl As Access.Control
Dim lst As Access.ListBox
Dim strName As String
Dim strCompanyName As String
Dim strAddress As String
Dim strSalutation As String
Dim strEnvelopeName As String
Dim strEnvelopeCompany As String
Dim strEnvelopeAddress As String
Dim strJobTitle As String
Dim strTestFile As String
Dim varItem As Variant
Dim intIndex As Integer
Dim intCount As Integer
Dim strWordTemplate As String
Dim prps As Object
Dim strShortDate As String
Dim strLongDate As String
Dim strDocsPath As String
Dim strTemplatePath As String
Dim intRow As Integer
Dim intRows As Integer
Dim intColumn As Integer
Dim intColumns As Integer
Dim strTest As String
Dim strCountry As String
Dim strDocType As String
Dim strSaveName As String
Dim intSaveNameFail As String
Dim i As String
Dim strSaveNamePath As String
Dim ChangeDate As Date, WordedDate As String



'Check that a letter has been selected
strWordTemplate = "Contents Page.dot"

'Set global Word application variable; if Word is not running,
'the error handler defaults to CreateObject
Dim pappWord
'Set pappWord = GetObject(, "Word.Application")

Set pappWord = CreateObject("Word.Application")

strLongDate = Format(Date, "mmmm d, yyyy")
strShortDate = Format(Date, "d-m-yyyy")
strDocsPath = pappWord.Options.DefaultFilePath(wdDocumentsPath) & "\"
strTemplatePath = "I:\IT\MIS Project\Projects\Project 09 - Shareholders Database\Contents Page"
'strTemplatePath = pappWord.Options.DefaultFilePath(wdUserTemplatesPath)
strWordTemplate = strTemplatePath & "\" & strWordTemplate

Debug.Print strWordTemplate

'Check for existence of template in template folder,
'and exit if not found
strTestFile = Nz(Dir(strWordTemplate))
Debug.Print "Test file: " & strTestFile
If strTestFile = "" Then
MsgBox strWordTemplate & " template not found; can't create letter"
GoTo ErrorHandlerExit
End If

Dim IntWordCERTID As String
Dim StrWordFirstName As String
Dim StrWordSurname As String
Dim ListCert

'Open a new letter based on the selected template
pappWord.Documents.Add strWordTemplate


For Each varItem In LstAllShares.ItemsSelected

If LstAllShares = "" Then

ListCert = LstAllShares.ItemData(varItem)

Else

ListCert = LstAllShares.ItemData(varItem)

IntWordCERTID = Nz(Me.LstAllShares.Column(0, varItem))
StrWordSurname = Nz(Me.LstAllShares.Column(7, varItem))
StrWordFirstName = Nz(Me.LstAllShares.Column(8, varItem))

Dim StrPasteString As String

StrPasteString = IntWordCERTID & " " & StrWordSurname & " " & StrWordFirstName

'Write information to Word bookmarks
On Error Resume Next
With pappWord.Selection

.GoTo What:=wdGoToBookmark, Name:="ContentsList"
.TypeText Text:=StrPasteString
.InsertParagraphAfter
.InsertParagraphAfter

End With

On Error GoTo ErrorHandler

'Check for existence of previously saved letter in documents folder,
'and append an incremented number to save name if found
strDocType = pappWord.ActiveDocument.BuiltInDocumentProperties(2)
strSaveName = StrWordFirstName & " " & StrWordSurname
strSaveName = strSaveName & " on " & strShortDate & ".doc"
i = 2
intSaveNameFail = True

Do While intSaveNameFail
strSaveNamePath = strDocsPath & strSaveName
Debug.Print "Proposed save name and path: " _
& vbCrLf & strSaveNamePath
strTestFile = Nz(Dir(strSaveNamePath))
Debug.Print "Test file: " & strTestFile
If strTestFile = strSaveName Then
Debug.Print "Save name already used: " & strSaveName

'Create new save name with incremented number
intSaveNameFail = True
strSaveName = CStr(i) & " " & StrWordFirstName & " " & StrWordSurname
strSaveName = strSaveName & " on " & strShortDate & ".doc"
strSaveNamePath = strDocsPath & strSaveName
Debug.Print "New save name and path: " _
& vbCrLf & strSaveNamePath
i = i + 1
Else
Debug.Print "Save name not used: " & strSaveName
intSaveNameFail = False
End If
Loop

'Update fields in Word document and activate it
With pappWord
.Selection.WholeStory
.Selection.Fields.Update
.Selection.HomeKey Unit:=wdStory
.ActiveDocument.SaveAs strSaveName
End With
'Next varItem

With pappWord
.ActiveWindow.WindowState = 0
.Visible = True
.Activate
End With


End If

Next varItem


ErrorHandlerExit:
Set pappWord = Nothing
Exit Sub

ErrorHandler:
'Word is not running; open Word with CreateObject
If Err.Number = 429 Then
Set pappWord = CreateObject("Word.Application")
Resume Next
Else
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End If

End Sub

 

[Chance1234]

change the source data to be in order on the listbox

Filmmaker, gentleman and [#Error]

http://WWW.5YLAC.S5.COM

http://WWW.HOWTOBESPOOKY.CO.UK

 

[TonyJollans]

Hi vicky666,

If, before you paste your text into Word, you move the cursor back one character so that the insertion point is before the bookmark, you should get what you want ..

[blue]    :
    :
    With pappWord.Selection
[red]
        .MoveStart wdCharacter, -1
        .Collapse wdCollapseStart
[/red]
        .GoTo What:=wdGoToBookmark, Name:="ContentsList"
        .TypeText Text:=StrPasteString
        .InsertParagraphAfter
        .InsertParagraphAfter

    End With
    :
    :[/blue]

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

 

[vicky666]

Chance1234, I think that may have worked, although I needed the list box displayed in numerical order.
Thank you for helping me out regardless though


TonyJollans, you were nearly right
The code you wrote just needed to go after the line you put them before. i.e.

.GoTo What:=wdGoToBookmark, Name:="ContentsList"

.MoveStart wdCharacter, -1
.Collapse wdCollapseStart

Either way it worked, so thank you so much, and enjoy the star

Cheers

Vicky

 

[TonyJollans]

Hi Vicky,

Oops! Yes, it won't do much good where I put it, will it? Made more effort making it look clear then making it correct! Glad you sorted it anyway.

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.