Microsoft Excel - Need a small VB script written for Excel

Good day Guru's,

I had a previous post that garnered no responses, so I'm assuming the post was too lenghty and confusing to work with.  So, I'm going to break it down into small pieces and put them together later somehow.  In the end though, the VB Script will need to work with both Excel and Word.  I know it can be done, I just don't know how.

I have a spreadsheet with all my information on Sheet 1 (RSVL ACCT Info), and my formulas work off of the entry in cell B2.  I have about 3,000 values (e-mail addresses) from the same spreadsheet on Sheet 2 (Update).

Piece 1 - This part should be a breeze...I need a small VB script that will take the e-mail address from Sheet 2, cell A1, and paste it into Sheet 1, cell B2, and then loop to the next e-mail address in A2, then A3 and so on until the list is either empty, or count down from a value of 3,000.


That is all I need for this post.  Only read below if you want to see what the other parts are.

The rest of the script I'm working with will be in Word.  The finished product will take the e-mail address from Sheet 2, put it in Sheet 1 (Cell B2).  From there I have a Word document where I need a script to (1) highlight the entire page (CTRL+A), and then (2) emulate an "F9" keystroke to update the links from the XL document.  Once the document is updated I need to use Mail Merge to e-mail the Word document to the e-mail address that was put into the XL Sheet 1, cell B2.  Once the e-mail is sent, the spreadsheet will go to the next e-mail address in Sheet 2 of the workbook and repeat for about 3,000 e-mails.

Thank you in advance for your help!

Hi Troy,
Are the data from Sheet2 to be copied only to Cell B2 or to B2, B3, B4 etc?  If they are copied only to B2, what is supposed to happen after each copy event?
Regards
Harry

Harry,

I replied to this last week but had issues trying to save the text, and it appears it did not go through.  Each entry from the Sheet2 would only go into cell B2 on Sheet1.  That is working perfectly.  The next step is to have the script go to an open Word document, highlight the entire document (CTRL+A), and then update the document (F9) and send the word document as an attachment.  I've just started learning VB myself so I'm sure there may be better ways, but I've not dabbled in programming since the late '80's with BASIC, DOS and machine language back in the 8088 and 8086 days.

Usually I'm here on the forums randomly trying to figure out how to do something for myself, but this started as an official project and I'm trying to get the funding to pay Rolf Jaeger for his code work to do this.  I don't want to undermine what Rolf has done but I'd like to know what I did wong here for my own education, and I am trying to do this so I can do this in a separate manner outside of what Rolf is helping with. 

The Word.Documents.Open is one area I don't understand.  I searched for alternate command to OPEN to switch to an already open Word document with no luck.  When I use the OPEN command the script moves past the open command, but the Word document is not visible.  I tried using the "Word.Visible = True" command but that was just opening a blank instance of Word.  The script stops at the Selection.WholeStory command without the visable command as well.  In the XL portion below, Sheet1=RSVL ACCT Info and Sheet2=Update.  I'm just lost on why Word isn't working with the script.

Sub Loops()

 Dim Word
 Dim WordDoc
 Set Word = CreateObject("Word.Application")
 Dim x As Integer
x = 0

Do Until ActiveCell = "End"
Sheets("Update").Select

x = x + 1

Cells(x, 1).Select
Selection.Copy
Sheets("RSVL ACCT Info").Select
Range("B2").Select
ActiveSheet.Paste

    Set WordDoc = Word.Documents.Open("C:\Users\U4211JTL\Documents\AT&T Reservationless\BLANK RESERVATIONLESS INFO.docx")
    Selection.WholeStory
    Selection.Fields.Update
   

Loop

End Sub

Hello Troy,
I am not very familiar with working in Word but there are a few things with your code that are worthy of review. However I need to understand a bit more what exactly it is trying to do.
It seems that you are looping through a column of data on one sheet and firstly reproducing that data one piece at a time in cell B2 on another sheet.  However in the code shown there does not appear to be any purpose in doing this, can you explain further?
Then it seems that you wish to update something in a Word document and it would appear that this is some pre-existing Field.  Or do you wish to add a new field for each piece of data that comes from the excel sheet?
I realise this code is designed to write data into a word table but it might be able to be modified to do what you want when we know what you want and it also shows some good principles in avoiding the use of select and copy/paste.

Sub test()

 

Dim wdDoc As Word.Document, wdApp As Word.Application

Dim tbl As Word.Table

 

 

Dim FileName As String

Dim iRow As Integer

Dim iCol As Integer

 

 

    FileName = "C:\_stuff\Local Files\temp.docx"

    Set wdApp = New Word.Application

 

    wdApp.Visible = True 'add this to see the Word instance and document

 

    Set wdDoc = wdApp.Documents.Open(FileName)

 

    Set tbl = wdDoc.Tables(1)

 

    ' Loop through columns and rows

    For iRow = 1 To 2

    For iCol = 1 To 3 ' or however many columns you have

      With Worksheets("Sheet1").Cells(iRow, iCol)

        tbl.Rows(iRow).Cells(iCol).Range.Text = .Value

      End With

    Next iCol

    Next iRow

 

 

    wdDoc.Close False  ' close doc and save changes

    wdApp.Quit      'close word (will auto-close if no open documents)

 

End Sub

Regards
Harry

Hello again Troy,
Re-read your first post and think I understand a bit better what you are trying to do.
This bit of code could also prove useful.

Function Update(Filepath As String)
    Dim WordApplication As Word.Application
    Dim WordDoc As Word.Document
    Dim updateLinks As Boolean

    Set WordApplication = CreateObject("Word.Application")
        updateLinks = WordApplication.Options.UpdateLinksAtOpen 'capture the original value
        WordApplication.Options.UpdateLinksAtOpen = False      'temporarily disable

    Set WordDoc = WordApplication.Documents.Open(Filepath)
        WordDoc.Fields.Update
        'MsgBox "Links updated in " & WordDoc.Name
        '## Save and Close the Document
        WordDoc.Save
        WordDoc.Close

    '## reset the previous value and Quit the Word Application
    WordApplication.Options.UpdateLinksAtOpen = updateLinks             '
    WordApplication.Quit

End Function

Regards
Harry

Thank you Harry,

The Sheet1 Cell B2 in the workbook is the VLOOKUP reference value. I have 25 VLOOKUP formula's working off of this B2 reference.  The Word document has links to these 25 VLOOKUP formula's in Excel so when the Word document is updated, it adds the information from these 25 links to complete the Word document for me. 

I tried to test the script you listed, but I'm new to VB programming and I'm doing something wrong.  I trie to put this into Excel and Word as a module, but I'm not getting this to work properly.  Did you intend for this new function to be called from the XL VB script, or in the Word document so when it opens it automatically updates the links based on whatever e-mail is in the B2 cell of the XL Workbook?

Hello Troy,
The code was not intended to work directly with your application.  It was only intended as an example of what was necessary to get the various parts of what you want to do to work.
I will try to have a look at your code and modify it to suit but there is obviously more to it than you have shown so it will be a bit of a pig in a poke I am afraid.
Regards
Harry

Hi Troy,
No guarantees but have a look at this.

Option Explicit
Sub test()

Dim wdDoc As Word.Document, wdApp As Word.Application
Dim FileName As String
Dim intCnt As Integer
Dim rngSrc As Range, rngDst As Range, rngCell As Range
Dim updateLinks As Boolean

'set up the Word document
FileName = "C:\Users\U4211JTL\Documents\AT&T Reservationless\BLANK RESERVATIONLESS INFO.docx"
Set wdApp = New Word.Application
wdApp.Visible = True 'add this to see the Word instance and document
updateLinks = wdApp.Options.UpdateLinksAtOpen 'capture the original value
wdApp.Options.UpdateLinksAtOpen = False 'temporarily disable
Set wdDoc = wdApp.Documents.Open(FileName) 'open the template file

'set up the Excel data ranges
Set intCnt = Worksheets("Update").Range("A:A").Count - 1 'adjust this subtraction depending on non-relevant cells in range
Set rngSrc = Worksheets("Update").Range("A1").Resize(intCnt, 1) 'adjust starting point if necessary
Set rngDest = Worksheets("RSVL ACCT Info").Range("B2")

' loop through cells in source range and update Word doc fields
For Each rngCell In rngSrc
    rngDst.Value = rngCell.Value
    wdDoc.Fields.Update
    'Probably need more code here
Next rngCell

wdDoc.Close False  'close doc and save chamges
wdApp.Options.UpdateLinksAtOpen = updateLinks ' restore previous value
wdApp.Quit  'quit Word

End Sub

A bit hard for me to test and not sure how you want to exit Word at the end.
Regards
Harry

Hi Troy,
Decided to do a bit of a test and showed up a couple of errors (one of the problems of working in different languages).
This seems to work in the simle minded test that I did.

Option Explicit
Sub test()

Dim wdDoc As Object, wdApp As Object
Dim FileName As String
Dim intCnt As Integer
Dim rngSrc As Range, rngDst As Range, rngCell As Range
Dim updateLinks As Boolean

'set up the Word document
FileName = "C:\Users\Harry\Documents\word\wordtest.docx" 'C:\Users\U4211JTL\Documents\AT&T Reservationless\BLANK RESERVATIONLESS INFO.docx"
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True 'add this to see the Word instance and document
updateLinks = wdApp.Options.UpdateLinksAtOpen 'capture the original value
wdApp.Options.UpdateLinksAtOpen = False 'temporarily disable
Set wdDoc = wdApp.Documents.Open(FileName) 'open the template file

'set up the Excel data ranges
intCnt = WorksheetFunction.CountA(Worksheets("Update").Range("A:A")) 'adjust this subtraction depending on non-relevant cells in range
Set rngSrc = Worksheets("Update").Range("A1").Resize(intCnt, 1) 'adjust starting point if necessary
Set rngDst = Worksheets("RSVL ACCT Info").Range("B2")

' loop through cells in source range and update Word doc fields
For Each rngCell In rngSrc
    rngDst.Value = rngCell.Value
    wdDoc.Fields.Update
    'Probably need more code here
Next rngCell

wdDoc.Close False  'close doc and save chamges
wdApp.Options.UpdateLinksAtOpen = updateLinks ' restore previous value
wdApp.Quit  'quit Word

End Sub

Regards
Harry