Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations TouchToneTommy on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

exporting Access Data to Word - how do i loop through subform's table data and export it to word 1

Status
Not open for further replies.

Gregory1979

Technical User
Sep 7, 2017
3
ZA
Hi!
I'm in serious need of help, I've searched everywhere and asked on every forum I can find... Please Help!!!! [ponder]

I have an access database with a few tables and a main form. What happens is: I fill in the main form with the customers details (applications for liquor licenses), when I save it, the data is put into the various tables, works great. There is a subform that can have multiple entries (for directors belonging to the company that is making the application). This also works perfectly.
Then, there is a button on the form which exports all the data related to that specific application into a word document. This also works perfectly.

The problem that I have is that I want to have the data related to the subform outputted to a table in word. I need to write a function that can loop through the subform's table and export only the entries related to that specific license application.
I've put the files on google drive if that will help you understand the problem and see the database in action. It's pretty cool.
Link

Someone suggested I try this code snip in my function, but I can't get it to work:
Code:
    'Loop data
    Set rs = CurrentDb().OpenRecordset("SELECT * FROM TableName WHERE [Criteria]", dbOpenSnapshot)
    With rs
        If Not .EOF Then
            .MoveLast
            .MoveFirst
        End If
    End With

    Dim idx As Integer
    For idx = 1 To rs.RecordCount
        With oDoc.Tables(1)
            .Cell(idx, 1).Range.Text = rs![FieldName_1]
            .Cell(idx, 2).Range.Text = rs![FieldName_2]
            .Cell(idx, 3).Range.Text = rs![FieldName_1]

            'add extra rows if required
            If rs.AbsolutePosition <> rs.RecordCount - 1 Then .Columns(1).Cells.Add
        End With
        rs.MoveNext
    Next idx


Here is the full code that I am using now, which works perfectly, but does not do the subform loop...

Code:
Public Sub ExportToWord_Click()
    On Error GoTo ErrorTrap

    Const TemplatePath As String = "C:\forms\templates\Form 3 - Sec 36(1).docx"

    'SaveAs
    Dim name_ As String
        name_ = "C:\forms\generated\" & Me![ACNumber] & "_Form 3 - Sec 36(1).docx"

    'Word
    Dim oWord As Word.Application
    Set oWord = New Word.Application
        oWord.Visible = True

    Dim oDoc As Word.Document
    Set oDoc = oWord.Documents.Add(TemplatePath)
    With oDoc
        .Bookmarks("wAppTradingNames").Range.Text = Nz(Me![AppTradingName], "")
        .Bookmarks("wAppTradingName").Range.Text = Nz(Me![AppTradingName], "")
        .Bookmarks("wCompanyName").Range.Text = Nz(Me![CompanyName], "")
        .Bookmarks("wCompanyNumber").Range.Text = Nz(Me![CompanyNumber], "")
        .Bookmarks("wRAddress1").Range.Text = Nz(Me![RAddress1], "")
        .Bookmarks("wPostalCode").Range.Text = Nz(Me![PostalCode], "")
        .Bookmarks("wRPostalAddress1").Range.Text = Nz(Me![RPostalAddress1], "")
        .Bookmarks("wRPostalCode").Range.Text = Nz(Me![RPostalCode], "")
        .Bookmarks("wDomicilium1").Range.Text = Nz(Me![Domicilium1], "")
        .Bookmarks("wDomiciliumCode").Range.Text = Nz(Me![DomiciliumCode], "")
        .Bookmarks("wDomAfter1").Range.Text = Nz(Me![DomAfter1], "")
        .Bookmarks("wDomAfterCode").Range.Text = Nz(Me![DomAfterCode], "")
        .Bookmarks("wTelOffice").Range.Text = Nz(Me![TelOffice], "")
        .Bookmarks("wTelCell").Range.Text = Nz(Me![TelCell], "")
        .Bookmarks("wTelHome").Range.Text = Nz(Me![TelHome], "")
        .Bookmarks("wFaxNumber").Range.Text = Nz(Me![FaxNumber], "")
        .Bookmarks("wEmail").Range.Text = Nz(Me![Email], "")
        .Bookmarks("wFIP").Range.Text = Nz(Me![FIP], "")
        .Bookmarks("wAppLicCat").Range.Text = Nz(Me![AppLicCat], "")
        .Bookmarks("wLPAddress").Range.Text = Nz(Me![LPAddress], "")
        .Bookmarks("wErfNumber").Range.Text = Nz(Me![ErfNumber], "")
        .Bookmarks("wLPPostalCode").Range.Text = Nz(Me![LPPostalCode], "")
        .Bookmarks("wLPOwnership").Range.Text = Nz(Me![LPOwnership], "")
        .Bookmarks("wLPOwnersName").Range.Text = Nz(Me![LpOwnersName], "")
        .Bookmarks("wLpOwnerAddress").Range.Text = Nz(Me![LpOwnerAddress], "")
        .Bookmarks("wLpRightOccupation").Range.Text = Nz(Me![LpRightOccupation], "")
        .Bookmarks("wLPOccDuration").Range.Text = Nz(Me![LPOccDuration], "")
        .Bookmarks("wLpPremNotErected").Range.Text = Nz(Me![LpPremNotErected], "")
        .Bookmarks("wLpPremAlterReq").Range.Text = Nz(Me![LpPremAlterReq], "")
        .Bookmarks("wLpPremAllGood").Range.Text = Nz(Me![LpPremAllGood], "")
        .Bookmarks("wLpBuildCommence").Range.Text = Nz(Me![LpBuildCommence], "")
        .Bookmarks("wLpBuildDuration").Range.Text = Nz(Me![LpBuildDuration], "")
        .Bookmarks("wLpTradingHours").Range.Text = Nz(Me![LpTradingHours], "")
        .Bookmarks("wLpRenewal").Range.Text = Nz(Me![LpRenewal], "")
        .Bookmarks("wLpJobsa").Range.Text = Nz(Me![LpJobsa], "")
        .Bookmarks("wLpJobsB").Range.Text = Nz(Me![LpJobsB], "")
        .Bookmarks("wLpJobsC").Range.Text = Nz(Me![LpJobsC], "")
        .Bookmarks("wNNPRegName").Range.Text = Nz(Me![NNPRegName], "")
        .Bookmarks("wNNPRegNumber").Range.Text = Nz(Me![NNPRegNumber], "")
        .Bookmarks("wNNPRegDate").Range.Text = Nz(Me![NNPRegDate], "")
    End With
       
    'Save
    With oDoc
        .SaveAs FileName:=name_, FileFormat:=Word.WdSaveFormat.wdFormatXMLDocument
        .Close SaveChanges:=wdDoNotSaveChanges
    End With

Leave:
    On Error Resume Next
        rs.Close
    Set rs = Nothing
        oWord.Quit
    Set oWord = Nothing
    On Error GoTo 0
    Exit Sub

ErrorTrap:
    MsgBox Err.Description, vbCritical, "ExportToWord()"
    Resume Leave
End Sub
 
You need to loop through the underlying recordset of your subform. So you've got a loop that's in the Word table.

What you need to do is:
1. Loop through the data source records
2. In Word, then you don't loop, you just make it go to the next empty row when you get to a new source data row

However, there' may be a better way that doesn't involve looping. I've never done it with Word, but in Excel, you can link in data. Are there any issues linking in data in Word from the source database? That will run more quickly, as it's just pullin the full query results into Word. If the table has properties, see if you can set it to an Access database table or query. That's what I would prefer to do if it were me. Even if you don't want to retain the link, you can set it up, get the data, then remove the link.

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57
 
Hi kjv1611,

Thanks, you understand my problem exactly! Inserting the data into word isn't such a problem, I can create a table in the word doc and have the data insert record for record into the table. I'm busy testing code that can do that now.
Creating a loop to retrieve the data has got me stumped though.
I'm a beginner at Access and VBA, typical of me to start in the deep end :)
 
So to get to the data in Access, I usually would either:
1. Create a query or
2. Create the query to get the correct SQL, then copy/paste it to VBA, and save as a SQL string variable.
3. Then create a DAO.Recordset to house it.

The start in Access would look something like:
[CODE VBA]Dim db as DAO.Database
Dim rs as DAO.Recordset
Dim strSQL as String ' to house the SQL Query

strSQL = "SELECT * FROM tblMyTable WHERE Status = 1 ORDER BY InsertDate;"

Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)

Do While Not rs.EOF
'Use your Word recordset here to capture values from Access recordset:
With oDoc
.Bookmarks("wAppTradingNames").Range.Text = Nz(Me![AppTradingName], "")
.Bookmarks("wAppTradingName").Range.Text = Nz(Me![AppTradingName], "")
.Bookmarks("wCompanyName").Range.Text = Nz(Me![CompanyName], "")
.Bookmarks("wCompanyNumber").Range.Text = Nz(Me![CompanyNumber], "")
' ... and so on...

' Then you'll need some code in Word to move to the next data row, which I'm not familar with, but I would think it can't be too difficult.

'Once you're finished with the Access database record, Move to the next record in the Access recordset:
rs.MoveNext
Loop
[/CODE]








"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57
 
Thanks for the help!!
I've managed to get it going beautifully with the code below. (I moved away from the SQL bits completely and went with Form.RecordsetClone to get the subform data.
All I had to do was create a table in my word doc with one row and correct amount of columns. It's the 6'th table on the page, so it's labeled "table(6)"
So, it loops through the subform data and adds it into the table row by row perfectly!


Code:
Public Sub ExportToWord_Click()
    On Error GoTo ErrorTrap

10    Const TemplatePath As String = "C:\forms\templates\Form 3 - Sec 36(1).dotx"

    'SaveAs
20    Dim name_ As String
30        name_ = "C:\forms\generated\" & Me![ACNumber] & "_Form 3 - Sec 36(1).docx"

    'Word
40    Dim oWord As Word.Application
50    Set oWord = New Word.Application
60        oWord.Visible = True

70    Dim oDoc As Word.Document
80    Set oDoc = oWord.Documents.Add(TemplatePath)
90    With oDoc
100        .Bookmarks("wAppTradingNames").Range.Text = Nz(Me![AppTradingName], "")
110        .Bookmarks("wAppTradingName").Range.Text = Nz(Me![AppTradingName], "")
120        .Bookmarks("wCompanyName").Range.Text = Nz(Me![CompanyName], "")
           '........
770    End With

    Dim rs As Recordset: Set rs = Me.[5 Director Details subform].Form.RecordsetClone
    With rs
            .MoveLast
        If Not .EOF Then
            .MoveLast
            .MoveFirst
        End If
    End With

    Dim idx As Integer
    For idx = 1 To rs.RecordCount

        With oDoc.Tables(6)
            .Cell(idx, 1).Range.Text = Nz(rs![PersonLabel], "")
            .Cell(idx, 2).Range.Text = Nz(rs![FullName], "")
            .Cell(idx, 3).Range.Text = Nz(rs![PhAddress], "") & vbCr & Nz(rs![PhCode], "")
            .Cell(idx, 4).Range.Text = Nz(rs![PAddress], "") & vbCr & Nz(rs![PCode], "")
            .Cell(idx, 5).Range.Text = Nz(rs![IdNumber], "")
            If rs.AbsolutePosition <> rs.RecordCount - 1 Then .Columns(1).Cells.Add
        End With
        rs.MoveNext
    Next idx

      'Save
    With oDoc
        .SaveAs FileName:=name_, FileFormat:=Word.WdSaveFormat.wdFormatXMLDocument
        .Close SaveChanges:=wdDoNotSaveChanges
    End With

Leave:
   On Error Resume Next
       rs.Close
   Set rs = Nothing
       oWord.Quit
   Set oWord = Nothing
   On Error GoTo 0
   Exit Sub

ErrorTrap:
    MsgBox Err.Description, vbCritical, "ExportToWord()" & Erl
    Resume Leave
End Sub
 
kjv1611,
You created a recordset, but still use the fields from the Form.
Is this what you wanted to express? Assuming the fields in the rs correspond to the Bookmarks in Word

Code:
Do While Not rs.EOF[green]
    'Use your Word recordset here to capture values from Access recordset:[/green]
    With oDoc
        .Bookmarks("wAppTradingNames").Range.Text = [blue]rs!AppTradingName.Value & ""[/blue]
        .Bookmarks("wAppTradingName").Range.Text = [blue]rs!AppTradingName.Value & ""[/blue]
        .Bookmarks("wCompanyName").Range.Text = [blue]rs!CompanyName.Value & ""[/blue]
        .Bookmarks("wCompanyNumber").Range.Text = [blue]rs!CompanyNumber.Value & ""[/blue][green]
    ' ... and so on...

    ' Then you'll need some code in Word to move to the next data row, which I'm not familar with, but I would think it can't be too difficult.
    
    'Once you're finished with the Access database record, Move to the next record in the Access recordset:[/green]
    rs.MoveNext
Loop

Have fun.

---- Andy

There is a great need for a sarcasm font.
 
I simply copied and pasted his existing code to show where it would go. Obviously, he'd use different variables to signify different objects. I just didn't take the time to modify further.

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top