p2p.wrox.com Forums

Need to download code?

View our list of code downloads.


Go Back   p2p.wrox.com Forums > Microsoft Office > Other Office > Word VBA
I forgot my password Register Now
Register | FAQ | Members List | Calendar | Search | Today's Posts | Mark Forums Read
Word VBA Discuss using VBA to program Word.

Welcome to the p2p.wrox.com Forums.

You are currently viewing the Word VBA section of the Wrox p2p Programmer to Programmer discussion community. This is a community of more than 40,000 computer programmers including Wrox book authors and readers. As a guest, you can read any forum posting. By joining our free Wrox p2p community you can post your own programming questions and respond to other programmers’ questions. Registered users also don't have to see the ads that are displayed to guests. Registration is fast, simple and absolutely free so please, join today!
Join today and post to win prizes! Post more to increase your chances of being Wrox’s top poster of the month.

Reply
 
Thread Tools Search this Thread Display Modes
  #1 (permalink)  
Old May 11th, 2009, 08:34 AM
Registered User
Points: 5, Level: 1
Points: 5, Level: 1 Points: 5, Level: 1 Points: 5, Level: 1
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: May 2009
Posts: 1
Thanks: 0
Thanked 0 Times in 0 Posts
Default Excel to Word VBA

Hi guys,

I was hoping you could help me with something quickly. I have the following script:

Code:
Sub rejection()

        ' word document object creation
        Dim WordApp As Object

        Dim i As Integer, j As Integer, numRows As Integer


        ' show the actions that the macro is performing for now
                Application.ScreenUpdating = False
       ' the submissions worksheet must be selected
        Set Data = ActiveSheet.Range("A1")
        numRows = ActiveSheet.UsedRange.Rows.Count

        For i = 1 To numRows

            ' pull column for each row into dynamic strings
            rejectType = Data.Offset(i - 1, 4).Value
            authorString = Data.Offset(i - 1, 1).Value
            insightsString = Data.Offset(i - 1, 6).Value
            alternateJournalString = Data.Offset(i - 1, 5).Value

            ' if no value for field
            If rejectType <> "quality" And rejectType <> "Subject" Then
            GoTo Nextif
            End If
            


            If rejectType = "quality" And qualityRejectionTemplateFile = "" Then
                MsgBox ("Please locate Quality-based rejection letter template file")
                qualityRejectionTemplateFile = Application.GetOpenFilename
            ElseIf rejectType = "Subject" And subjectRejectionTemplateFile = "" Then
                MsgBox ("Please locate Subject-based rejection letter template file")
                subjectRejectionTemplateFile = Application.GetOpenFilename
            End If


            ' create rejection letter
            Set WordApp = CreateObject("Word.Application")

            With WordApp
                Application.StatusBar = "Creating " & rejectType & "rejection letter from template"
                .Visible = True

                ' should be .dot, a template file
                ' should be placed in the same directory as the excel file that this is being called from

                If rejectType = "quality" Then
                    .Documents.Open qualityRejectionTemplateFile
                ElseIf rejectType = "Subject" Then
                    .Documents.Open subjectRejectionTemplateFile
                End If

                ' clear out find and replace fields
                .Selection.Find.ClearFormatting
                .Selection.Find.Replacement.ClearFormatting

                ' find and replace the name in the document
                With .Selection.Find
                    .Text = "<Name>"
                    .Replacement.Text = authorString
                    .Wrap = wdFindStop
                    .Execute Replace:=wdReplaceAll
                End With

                ' clear out find and replace fields
                .Selection.Find.ClearFormatting
                .Selection.Find.Replacement.ClearFormatting

                ' find and replace the Insights in the document
                With .Selection.Find
                    .Text = "<insights>"
                    .Replacement.Text = insightsString
                    .Wrap = wdFindStop
                End With

                .Selection.Find.Execute Replace:=wdReplaceAll

                ' clear out find and replace fields
                .Selection.Find.ClearFormatting
                .Selection.Find.Replacement.ClearFormatting

                ' find and replace the Alternate Journal name in the document
                With .Selection.Find
                    .Text = "<Alternate Journal>"
                    .Replacement.Text = alternateJournalString
                End With

                .Selection.Find.Execute Replace:=wdReplaceAll



                ' save document with appropriate name and close
                .ActiveDocument.SaveAs Filename:=authorString & "_reject_" & rejectType & ".doc"
                .ActiveWindow.Close
                ' Kill the object
                .Quit

End With

Nextif:
Next i

End Sub
For the life of me, I cannot figure out why the Replacement.Text function doesn't work. When the macro is running, you can see it select <Name>, but it doesn't make any changes before it closes it and opens a new instance (It doesn't move on to <insights> or <alternate journal>)

Anyone have any ideas??

Thank you so much. I've learned a lot from these boards.
Digg this Post!Add Post to del.icio.usBookmark Post in TechnoratiFurl this Post!Reddit!
Reply With Quote
  #2 (permalink)  
Old May 11th, 2009, 09:25 PM
Friend of Wrox
Points: 1,449, Level: 15
Points: 1,449, Level: 15 Points: 1,449, Level: 15 Points: 1,449, Level: 15
Activity: 17%
Activity: 17% Activity: 17% Activity: 17%
 
Join Date: Sep 2005
Location: , , .
Posts: 420
Thanks: 0
Thanked 14 Times in 14 Posts
Default

Hi

Try changing the Wrap to wdFindContinue

With .Selection.Find
.Text = "<Name>"
.Replacement.Text = authorString
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With


Cheers
Shasur
__________________
C# Code Snippets (http://www.dotnetdud.blogspot.com)

VBA Tips &amp; Tricks (http://www.vbadud.blogspot.com)
Digg this Post!Add Post to del.icio.usBookmark Post in TechnoratiFurl this Post!Reddit!
Reply With Quote
Reply


Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

vB code is On
Smilies are On
[IMG] code is Off
HTML code is Off
Trackbacks are Off
Pingbacks are On
Refbacks are Off
Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Code works in Excel VBA but not Access VBA fossx Access VBA 2 May 21st, 2007 09:00 AM
Converting excel data to Access using excel VBA ShaileshShinde VB Databases Basics 1 April 26th, 2006 08:57 AM
Excel VBA to SQL & back to VBA edesousa Excel VBA 1 June 1st, 2004 03:39 AM
Word VBA sdowen Excel VBA 4 December 3rd, 2003 04:32 PM
VBA Word gcookie79 Excel VBA 1 November 12th, 2003 01:04 PM



All times are GMT -4. The time now is 04:29 AM.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2009, Jelsoft Enterprises Ltd.
© 2008 Wiley Publishing, Inc