Export data to a word template and create a doc

[Hfnet]

I have created a template, and a query in Access to create documents, however I must be missing something, as access says doc created, butt when I look at the created doc, all of my control fields are still there and no data has been added.

I will list the code below that creates the doc, and in the document template I have a table with $1, $2 etc for where the data should go. I have seen this done so I know it SHOULD work, but I guess something needs to be in the template to link it??

Code from Access:

Dim app As Word.Application
Dim doc As Word.Document
Dim i As Long
Set rst = CurrentDb.OpenRecordset("SELECT HWReplacedItems.StockLinkID, HWItems.Description, HWReplacedItems.DateIn, HWUsers.UserName AS Engineer, HWReplacedItems.SAP, HWReplacedItems.Batch, HWReplacedItems.ReplaceReason, HWReplacedItems.ItemIsRMA, HWReplacedItems.SourceSerial, HWReplacedItems.SourceCName, HWReplacedItems.SourceCTekref, HWStock.DateIn AS NIDateIn, HWItems_1.Description AS NIDescription, HWUsers_1.UserName AS NIEngineer, HWSources.SourceName AS NISource, HWStock.SAP AS NISAP, HWStock.Batch AS NIBatch, HWUsageReasons.Reason, HWUsed.SaleOrder, HWStock.PONumber, HWStock.RMAStockNumber AS NIRMAStockNumber, HWStock.RMAItemCode AS NIRMAItemCode, HWReplacedItems.RMAStockNumber, HWReplacedItems.RMAItemCode " & _
"FROM (((((((HWReplacedItems LEFT JOIN HWItems ON HWReplacedItems.ItemID = HWItems.ID) LEFT JOIN HWStock ON HWReplacedItems.StockLinkID = HWStock.ID) LEFT JOIN HWSources ON HWStock.SourceID = HWSources.ID) LEFT JOIN HWUsers ON HWReplacedItems.UserID = HWUsers.ID) LEFT JOIN HWItems AS HWItems_1 ON HWStock.ItemID = HWItems_1.ID) LEFT JOIN HWUsers AS HWUsers_1 ON HWStock.UserID = HWUsers_1.ID) LEFT JOIN HWUsed ON HWReplacedItems.StockLinkID = HWUsed.StockLinkID) LEFT JOIN HWUsageReasons ON HWUsed.UsageReasonID = HWUsageReasons.ID " & _
"WHERE (((HWReplacedItems.StatusID) = 2)) " & _
"ORDER BY HWReplacedItems.StockLinkID; ")

If Not rst.EOF Then
rst.MoveLast
rst.MoveFirst
i = 0
Do: iold = i: i = InStr(i + 1, CurrentDb.Name, "\"): Loop While i <> 0
If iold = 0 Then
MsgBox "Cannot extract Database Path. Exiting", vbOKOnly + vbCritical
Exit Sub
End If

Set app = New Word.Application

Do While Not rst.EOF

Set doc = app.Documents.Add(Left$(CurrentDb.Name, iold) & "faultform.dot")
For y = 1 To doc.Tables(1).Rows.Count
For x = 1 To 4
S = ""
On Local Error Resume Next
S = doc.Tables(1).Cell(y, x).Range.Text
On Local Error GoTo 0
i = 0
Do
i = InStr(i + 1, S, "$")
If i > 0 Then
ist = i
i = InStr(i + 1, S, "$")
If i > 0 Then
ien = i
tS = Mid(S, ist + 1, ien - (ist + 1))
For j = 1 To Len(tS)
If Mid$(tS, j, 1) < "0" Or Mid$(tS, j, 1) > "9" Then Exit For
Next j
If j = Len(tS) + 1 Then
ttS = ""
On Local Error Resume Next
ttS = rst.Fields(Val(tS) - 1).Value
On Local Error GoTo 0
S = Left$(S, ist - 1) & ttS & Right$(S, Len(S) - ien)
If Right$(S, 2) = Chr$(&HD) & Chr$(&H7) Then
S = Left$(S, Len(S) - 2) & Chr$(&H7)
End If
doc.Tables(1).Cell(y, x).Range.Text = S
End If
End If
End If
Loop While i > 0

Next x
Next y
' app.Visible = True
' app.Activate
DoEvents
' Stop
doc.SaveAs Left$(CurrentDb.Name, iold) & "RIDocs\Item-" & rst.Fields(0).Value & "-.doc"
doc.Close
MsgBox "'Item-" & rst.Fields(0).Value & "-.doc' was saved"
CurrentDb.Execute "Update HWReplacedItems Set StatusID=3 Where StockLinkID=" & rst.Fields(0).Value
Set doc = Nothing
rst.MoveNext
Loop

app.Quit
Set app = Nothing
End If


--------

The Set rst line is on 4 lines,

line 2 starting "FROM
Line 3 starting "WHERE
Line 4 starting "ORDER

The $1, $2 fields in the word template relate to the Set rst code to populate the relevant details, and this is the bit that does not work.

Any ideas greatly received!

 

[lespaul]

When you say controls fields, do you mean bookmarks? If so, I would expect to see something like:

"Word.ActiveDocument.Bookmarks("Name").Range.Text = rs!Name"

You may have better luck posting this in the Access VBA Forum705.



Leslie

 

[Hfnet]

Well, not too sure. The code in Access is correct, I know because we have been using it for over a year. The original template got deleted, so I have taken an existing document that has been created by the code, renamed the fields as I remeber seeing them, but I am thinking there is something lurking underneath in the template

 

[lespaul]

There's no backup of the original template anywhere? What about a saved copy of the generated document?

Leslie

 

[Hfnet]

That's what I mean, I got a saved copy of a generated document, and replaced the data with the $ numbers. That is what was on the old template, so I assumed it would work, but now it creates the document from the template but puts no data in place of the $ numbers

 

[lespaul]

So, I'm trying to figure out exactly what you are trying to do with this code:

[COLOR=red]'for all the rows in the table[/color]
For y = 1 To doc.Tables(1).Rows.Count
  [COLOR=red]'for all the columns in the table[/color]
  For x = 1 To 4
    S = ""
    On Local Error Resume Next
    [COLOR=red]'assign the text in the first row and column to variable S[/color]
    S = doc.Tables(1).Cell(y, x).Range.Text
    On Local Error GoTo 0
    i = 0
    Do
      [COLOR=red]'look if cell contains a $ assign position to i[/color]
      i = InStr(i + 1, S, "$")
      If i > 0 Then
      [COLOR=red]'if cell contained a $ then assign position to ist[/color]
        ist = i
      [COLOR=red]'check to see if there is another $ in the string [/color]
        i = InStr(i + 1, S, "$")
        If i > 0 Then
      [COLOR=red]'if the cell contained a second $ assign the position to ien [/color]
          ien = i
      [COLOR=red]'assign what is between the two $ to variable tS [/color]
          tS = Mid(S, ist + 1, ien - (ist + 1))
      [COLOR=red]'check all characters found between the two $ for something?  here's where it's starting to get murky!! [/color]
          For j = 1 To Len(tS)
            If Mid$(tS, j, 1) < "0" Or Mid$(tS, j, 1) > "9" Then Exit For
          Next j
          If j = Len(tS) + 1 Then
            ttS = ""
            On Local Error Resume Next
            ttS = rst.Fields(Val(tS) - 1).Value
            On Local Error GoTo 0
            S = Left$(S, ist - 1) & ttS & Right$(S, Len(S) - ien)
            If Right$(S, 2) = Chr$(&HD) & Chr$(&H7) Then
              S = Left$(S, Len(S) - 2) & Chr$(&H7)
            End If
            doc.Tables(1).Cell(y, x).Range.Text = S
          End If
        End If
      End If
    Loop While i > 0
                
  Next x
Next y

Leslie

 

[Hfnet]

You have it up to the point it 'gets murky'!

It should pouplate any table cell with a $ in it with the corresponding value from the query. (i.e. $1 is the StocklinkID field)

I am beyond tired now so I will come back to it fresh in the morning, and I will post again if and when I crack it...

 

[lespaul]

shouldn't you have 2 $ in each one? if it only finds one $ it's not going to do anything. So maybe it should be $1$?

Leslie

 

[Hfnet]

It's funny that!! I was so tired I lost sight of the proper terminlogy!! I came into work this morning, looked at the template, saw my mistake, added the trailing $, presto, it worked.

Came here to tell you I had been too tired, and you saw it too!!

Thanks