loops help!

[gmatriix]

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

 

[Kafrin]

The setup you've got looks OK to me. The main problem is with the lines:
Do While ws.Cells(2, 1).Value <> ""
...and...
x = 2 + 1

...this means that after the first go through, x will always be set to 3, but you're not using x anyway. What you need there instead is:
Do While ws.Cells(x, 1).Value <> ""
...and...
x = x + 1

Other than that it all looks fine.

Just as a suggestion, I would usually dim C as Range, then instead of setting x=2 (you won't use x) you use:
Set C = ws.Cells(2,1)

Your "Do" line becomes:
Do Until C.Value=""

...and then instead of incrementing x you use:
Set C = C.Offset(1,0)
Loop

It is only a suggestion, purely personal choice, just thought I'd mention it.

 

[gmatriix]

Hey Thanks,

However, I am getting a complie error. "Loop without Do"

Any Ideas?

 

[DCrake]

For every Do you need a Loop, likewise for every If you need an End If, for every For you need an Next

Do Until.EOF

    Code appears here

     For X = 1 to 10

         Code appear here

         If X = 4 Then
 
              Code  appears here

         End If
     Next
Loop

By nesting and indenting your code you can easily see where the holes are

 

[boblarson]

I see an extra END WITH that doesn't have a WITH and then the one END WITH needs to be BEFORE the word LOOP not after it.

 

[gmatriix]

Thanks DCrape!!

I got it to loop however, it is not going to the next line on the excel sheet. So it is error out because it is pull the same informtion in first row. I also will need to close the document after it saves.

Can you see why it is not offsetting to the next row?

Thanks

Here is the code:

Sub Excel2word()
Dim wdApp As Object, wd As Object, ac As Long, ws As Worksheet
Dim SiteName, SaveAsName As String
Dim c As Range

Set ws = Workbooks("HI Market Tracker.xls").Worksheets("Sheet1")
Set c = ws.Cells(2, 1)
Do Until c.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.SaveAs Filename:=wd.formfields("Text38").Result, FileFormat:= _
        wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
        True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
        False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
wdApp.Visible = True

Set c = c.Offset(1, 0)

End With
Loop
Set wd = Nothing
Set wdApp = Nothing
End Sub

Thanks

 

[Kafrin]

It looks like it should be going through fine. I can't see what you're achieving by looping however, as the code inside the loop is identical every time, nothing changes.

Should your ws.Range("A2"), ws.Range("B2") bits be changing each time perhaps? If so then I can see why you were using an x variable to loop through your cells, and it may make sense for you to revert to this, so that your range bits become ws.Cells(x,1), ws.Cells(x,2), remembering that the syntax is ws.Cells(RowNum,ColumnNum).

Alternatively, using range C (which I see you've implemented), you need to use ws.Cells(C.Row,1), ws.Cells(C.Row,2), or dim R as integer and have
R = C.Row
so that you use ws.Cells(R,1), ws.Cells(R,2), etc. Don't forget to change the one in your filename string as well!

 

[gmatriix]

Hey,

I figured it out!!! (what do you know!)

Here the finished 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:\LCSites\" & wdDoc.formfields("Text38").Result & ".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

Thanks Everyone!