loop help!

[G-Matriix]

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!

 

[G-Matriix]

any thoughts?

 

[Colin Legg]

Using your example code as a template, I think this is the sort of thing you are looking for. It is untested.

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]

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]

Sorry, that's my fault. I didn't change the row references which are being applied to your formfields:

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...

 

[G-Matriix]

Hey thats Awesome!!!

Thanks alot!