loop help!

G-Matriix

Board Regular
Joined
Sep 20, 2006
Messages
139
Hello All,

I have this code. What the code is doing is taking data from a excel sheet and passing it to a word doc. What I am trying to do is ....for each row in excel loop through the code. So it would drop down the next row and loop again. Please forgive me...I am very new. Would I use a --Do while (x,1).Value<>""--I'm just not sure where to put the loop in this code?? Also could someone check the saveas portion to see if I did that correctly.

here is the code
-------------------------------------------------------
Sub Excel2word()
Dim wdApp As Object, wd As Object, ac As Long, ws As Worksheet
Dim SiteName, SaveAsName As String
x = 2
Set ws = Workbooks("HI Market Tracker.xls").Worksheets("Sheet1")
Do While ws.Cells(2, 1).Value <> ""
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
Set wd = wdApp.Documents.Open("C:\Final Mile Site Survey.doc")
wdApp.Visible = True
With wd
'Site Name
.formfields("Text39").Result = ws.Range("A2").Value
'Site Number
.formfields("Text38").Result = ws.Range("B2").Value
'Latitude
.formfields("Text14").Result = ws.Range("F2").Value
'Longitude
.formfields("Text15").Result = ws.Range("G2").Value
'Address
.formfields("Text33").Result = ws.Range("K2").Value
'City
.formfields("Text34").Result = ws.Range("L2").Value
'State
.formfields("Text35").Result = ws.Range("M2").Value
'Zip
.formfields("Text13").Result = ws.Range("N2").Value

SaveAsName = "C:\_LC_Sites\" + ws.Range("B2").Value + ".doc"
wd.Document.SaveAs Filename:=SaveAsName
wdApp.Visible = False
wd.Document.Close
x = 2 + 1
Loop
End With
Set wd = Nothing
Set wdApp = Nothing
End Sub

End With
Set wd = Nothing
Set wdApp = Nothing
End Sub
-------------------------------------------------------
Thanks!
 
Last edited:

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.

Colin Legg

MrExcel MVP
Joined
Feb 28, 2008
Messages
3,497
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Using your example code as a template, I think this is the sort of thing you are looking for. It is untested.

Code:
Sub Excel2word()
    Dim wdApp As Object, wdDoc As Object, ws As Worksheet
    Dim SaveAsName As String, r As Long
 
    Set ws = Workbooks("HI Market Tracker.xls").Worksheets("Sheet1")
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True
 
    r = 2
 
    Do While LenB(ws.Cells(r, 1).Value) > 0
 
        Set wdDoc = wdApp.Documents.Add(template:="C:\Final Mile Site Survey.doc")
        With wdDoc
            'Site Name
            .formfields("Text39").Result = ws.Range("A2").Value
            'Site Number
            .formfields("Text38").Result = ws.Range("B2").Value
            'Latitude
            .formfields("Text14").Result = ws.Range("F2").Value
            'Longitude
            .formfields("Text15").Result = ws.Range("G2").Value
            'Address
            .formfields("Text33").Result = ws.Range("K2").Value
            'City
            .formfields("Text34").Result = ws.Range("L2").Value
            'State
            .formfields("Text35").Result = ws.Range("M2").Value
            'Zip
            .formfields("Text13").Result = ws.Range("N2").Value
 
            SaveAsName = "C:\_LC_Sites\" & ws.Range("B2").Value & ".doc"
            .SaveAs Filename:=SaveAsName
            .Close 0
        End With
        r = r + 1
    Loop
 
 
    Set wdDoc = Nothing
 
    If Not wdApp Is Nothing Then wdApp.Quit
    Set wdApp = Nothing
 
End Sub
 

G-Matriix

Board Regular
Joined
Sep 20, 2006
Messages
139
Hey Thanks,

This is working but it is just repeating the first row. it is not moving to the second row

Any Ideas?
 

Colin Legg

MrExcel MVP
Joined
Feb 28, 2008
Messages
3,497
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Sorry, that's my fault. I didn't change the row references which are being applied to your formfields:
Code:
Sub Excel2word()
    Dim wdApp As Object, wdDoc As Object, ws As Worksheet
    Dim SaveAsName As String, r As Long
 
    Set ws = Workbooks("HI Market Tracker.xls").Worksheets("Sheet1")
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True
 
    r = 2
 
    Do While LenB(ws.Cells(r, 1).Value) > 0
 
        Set wdDoc = wdApp.Documents.Add(template:="C:\Final Mile Site Survey.doc")
        With wdDoc
            'Site Name
            .formfields("Text39").Result = ws.Range("A" & r).Value
            'Site Number
            .formfields("Text38").Result = ws.Range("B" & r).Value
            'Latitude
            .formfields("Text14").Result = ws.Range("F" & r).Value
            'Longitude
            .formfields("Text15").Result = ws.Range("G" & r).Value
            'Address
            .formfields("Text33").Result = ws.Range("K" & r).Value
            'City
            .formfields("Text34").Result = ws.Range("L" & r).Value
            'State
            .formfields("Text35").Result = ws.Range("M" & r).Value
            'Zip
            .formfields("Text13").Result = ws.Range("N" & r).Value
 
            SaveAsName = "C:\_LC_Sites\" & ws.Range("B" & r).Value & ".doc"
            .SaveAs Filename:=SaveAsName
            .Close 0
        End With
        r = r + 1
    Loop
 
 
    Set wdDoc = Nothing
 
    If Not wdApp Is Nothing Then wdApp.Quit
    Set wdApp = Nothing
 
End Sub

Hope that helps...
 

Watch MrExcel Video

Forum statistics

Threads
1,129,754
Messages
5,638,170
Members
417,011
Latest member
Amaden95

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top