MS Access to MS Word

[awayne]

I am working with MS VB 6.5. I am putting together a MS Access (MS Access 2000) database for work to keep track of the projects and their status that we've done. I use MS Access to run a "Make-table query" that sorts by Ascending date (date is (Field(5) for coding purposes) and then use the information in the table to create the table in a word document. The query also captures beginning and ending dates so people can create a report that covers a couple of days to a report that can cover years.

Thanks to this forum, I have been pretty successful with most of my project and I am able to create the table and populate it with the correct information (code is below).

This one has stumped me for the past 2 days, though...What I would like to do is group the projects by the month they were submitted. For each month within the requested date range, I would like to insert a new row with the name of the month, then rows for each project that was submitted within that month.

I've tried adding new rows based on how many would need to be added (looking at the number of different months and adding those rows). I was able to create the table, but now I run into errors trying to populate the table. I've been getting a variety of errors, but the most common one is the "..Either the BOF or EOF is true..." error. I suspect this is because I have more rows than records.

Below is my working code to populate the table. I would be happy to share more of my code if it helps. I would also be happy to share some code I've tried, but didn't work if it helps. Any assistance would be greatly appreciated.

'Open the Pet table
With rstl
    .ActiveConnection = CurrentProject.Connection
    .Open "tblePet", , adOpenKeyset, adLockOptimistic, adCmdTable
End With
 
' Set reference to the document
 
'Create a Word application instance
 
Set myWDApp = CreateObject("Word.Application")
 
myWDApp.Documents.Add
Set myRange = myWDApp.ActiveDocument.Range(0, 0)
myWDApp.ActiveDocument.Tables.Add Range:=myRange, NumRows:=rstl.RecordCount + 2, NumColumns:=8
 
 
    'Fill in information
 
For irow = 3 To myWDApp.ActiveDocument.Tables(1).Rows.Count
Columncount = 3
 
  For Each acell In myWDApp.ActiveDocument.Tables(1).Rows(irow).Cells
    myWDApp.ActiveDocument.Tables(1).Cell(Row:=irow, Column:=1).Range.Text = (rstl.Fields(0)) & ", " & (rstl.Fields(1)) & " " & (rstl.Fields(2))
 
    If rstl.Fields(4) = "Pet" Then
      myWDApp.ActiveDocument.Tables(1).Cell(Row:=irow, Column:=2).Range.Text = (rstl.Fields(4)) & ", " & (rstl.Fields(11))
    End If
 
    acell.Range.Text = IIf(IsNull(rstl.Fields(Columncount)), "", rstl.Fields(Columncount))
    Columncount = Columncount + 1
 
  Next acell
  rstl.MoveNext
Next irow

[Killer42]

Which line is producing the error?

[Killer42]

Which line is producing the error?

Sorry, this is the code that does work, right?

I'm a bit unclear on exactly which part of the task you're asking for help with.

[awayne]

Sorry, this is the code that does work, right?

I'm a bit unclear on exactly which part of the task you're asking for help with.

That's correct. It is the working code that creates the table.

I think what I need to do is after the table is created, have it go through each row of column 3 (that's the date column) and compare the month in the current cell to the month in the previous row. If the are different then, insert a row above (This new row is where I could then put in the name of the month).

Below is the code I thought would work. However, I'm getting a "Type Mismatch" error at the first CDate. Also, I have "rowcount" start at 3 because I have two rows for a headings. Am I even going in the right direction here?? Thanks.

For rowcount = 3 To myWDApp.ActiveDocument.Tables(1).Rows.Count

For Each acell In myWDApp.ActiveDocument.Tables(1).Columns(3).Cells

' Ensure that the dates in the cell are in the proper date format

SubDate = CDateApp.ActiveDocument.Tables(1).Cell(Row:=rowcou nt, Column:=3))
PrevDateSub = CDate(myWDApp.ActiveDocument.Tables(1).Cell(Row:=r owcount - 1, Column:=3))

'Compare the current row to the previous row and insert a row above if they are different
If Month(SubDate) <> Month(PrevDateSub) Then
myWDApp.ActiveDocument.Tables(1).Rows.Select
myWDApp.ActiveDocument.Application.Selection.Inser tRowsAbove (1)

End If
Next acell
rstl.MoveNext
Next rowcount

[awayne]

That's correct. It is the working code that creates the table.

I think what I need to do is after the table is created, have it go through each row of column 3 (that's the date column) and compare the month in the current cell to the month in the previous row. If the are different then, insert a row above (This new row is where I could then put in the name of the month).

Below is the code I thought would work. However, I'm getting a "Type Mismatch" error at the first CDate. Also, I have "rowcount" start at 3 because I have two rows for a headings. Am I even going in the right direction here?? Thanks.

For rowcount = 3 To myWDApp.ActiveDocument.Tables(1).Rows.Count

For Each acell In myWDApp.ActiveDocument.Tables(1).Columns(3).Cells

' Ensure that the dates in the cell are in the proper date format

SubDate = CDateApp.ActiveDocument.Tables(1).Cell(Row:=rowcou nt, Column:=3))
PrevDateSub = CDate(myWDApp.ActiveDocument.Tables(1).Cell(Row:=r owcount - 1, Column:=3))

'Compare the current row to the previous row and insert a row above if they are different
If Month(SubDate) <> Month(PrevDateSub) Then
myWDApp.ActiveDocument.Tables(1).Rows.Select
myWDApp.ActiveDocument.Application.Selection.Inser tRowsAbove (1)

End If
Next acell
rstl.MoveNext
Next rowcount

I just noticed that I had a typo in "SubDate" line. It should have read:
SubDate = CDate(myWDApp.ActiveDocument.Tables(1).Cell(Row:=r owcount, Column:=3))

However, I'm still getting the "Type Mismatch" error.

[Dököll]

Sorry, this is the code that does work, right?

I'm a bit unclear on exactly which part of the task you're asking for help with.

Hey there, awayne!

First let me admit, I have no idea what is going on. So, my apologies for jumping in. I think what Killer is leading at is if you can skillfully tell which part you are having problems, that'll aid in getting the proper help.

If you look at what the code is doing by stepping into your code:

(1) Make visible your code pane

(2) Go to Debug

(3) Select Step into

(4) Hit F8 until you reach the error

The error will indeed pop...

Again, I cannot tell what is happening, stepping into it, I think, may shed some light.

You're in good hands here, have fun with the project.

[awayne]

Thanks. I appreciate everyone's patience.

Below is the full code up to where I get the "Type Mismatch" error. The bolded text is where it stops. The italized text is the code that I thought would compare the submission month of the project in the current row with the submission month in the previous row. If the month is different, then insert a new row (creating a new row between the different months).

Also, for some reason when I previewed this response, "InsertRowsAbove(1)" has a space in it, even if I type in the line. My original code does not have the space.

Option Compare Database
 
Sub fromAccessToWordSubmitted()
Dim myWDApp As Word.Application
Dim myDoc As Document
Dim myRange As Word.Range, myTable As Word.Table
Dim acell As Word.Cell, Columncount As Integer
Dim rstl As New Recordset, irow As Integer
Dim rowcount As Integer, SubDate As Date
Dim PrevDateSub As Date
 
 
'Open the In Process table
With rstl
    .ActiveConnection = CurrentProject.Connection
    .Open "tbleSubmitted", , adOpenKeyset, adLockOptimistic, adCmdTable
End With
 
' Set reference to the document
 
'Create a Word application instance
 
Set myWDApp = CreateObject("Word.Application")
 
'Add a document to the application and a table to the document.
'Specify number of rows in Submitted table in Access
myWDApp.Documents.Add
Set myRange = myWDApp.ActiveDocument.Range(0, 0)
 
myWDApp.ActiveDocument.Tables.Add Range:=myRange, NumRows:=(rstl.RecordCount + 2), NumColumns:=8
 
'Insert tables
 
    'Insert column headings
 
With myWDApp.ActiveDocument.Tables(1).Rows(1)
.Range.Text = "Submitted"
End With
With myWDApp.ActiveDocument.Tables(1).Rows(2)
    .Cells(1).Range.Text = "Project"
    .Cells(2).Range.Text = "Lead"
    .Cells(3).Range.Text = "Date Submitted"
    .Cells(4).Range.Text = "Manager"
    .Cells(5).Range.Text = "Executive"
    .Cells(6).Range.Text = "Team"
    .Cells(7).Range.Text = "Project Number"
    .Cells(8).Range.Text = "Cost"
End With
 
    'Fill in information
rcount = 0
 
For irow = 3 To (myWDApp.ActiveDocument.Tables(1).Rows.Count)
Columncount = 3
 
With myWDApp.ActiveDocument.Tables(1).Rows(irow)
.Range.Font.Size = 11
End With
 
For Each acell In myWDApp.ActiveDocument.Tables(1).Rows(irow).Cells
 
'Full name of project.
myWDApp.ActiveDocument.Tables(1).Cell(Row:=irow, Column:=1).Range.Text = (rstl.Fields(0)) & ", " & (rstl.Fields(1)) & " " & (rstl.Fields(2))
 
'Lead Column. If we are not the lead on the project, then who is leading the effort
If rstl.Fields(4) = "Not Lead" Then
myWDApp.ActiveDocument.Tables(1).Cell(Row:=irow, Column:=2).Range.Text = (rstl.Fields(4)) & ", " & (rstl.Fields(11))
End If
 
'Submission date column.  
myWDApp.ActiveDocument.Tables(1).Cell(Row:=irow, Column:=3).Range.Text = CDate(Format(rstl.Fields(5), "mm/dd/yyyy"))
 
'All other columns
 
acell.Range.Text = IIf(IsNull(rstl.Fields(Columncount)), "", rstl.Fields(Columncount))
Columncount = Columncount + 1
 
Next acell
rstl.MoveNext
Next irow
 
'Start in row 3 since the 1st 2 rows are header rows. Compare submission dates. If the month of the submission date in the current cell is different than the month of the sumission date from the previous row (same column though) then insert a new row above
 
 For rowcount = 3 To myWDApp.ActiveDocument.Tables(1).Rows.Count
For Each acell In myWDApp.ActiveDocument.Tables(1).Columns(3).Cells
 
 If Month(myWDApp.ActiveDocument.Tables(1).Cell(Row:= rowcount, Column:= 3).Range.Text <> Month(myWDApp.ActiveDocument.Tables(1).Cell(Row:= rowcount, Column:= 3).Range.Text) Then 
 
myWDApp.ActiveDocument.Tables(1).Rows.Select
myWDApp.ActiveDocument.Application.Selection.InsertRowsAbove1)
 
End If
Next acell
Next rowcount
 
 

[Killer42]

Um... isn't it conceivable that your problem is caused by trying to check the month in the new row that you just inserted?

As for the gap, I wouldn't worry about it. For some reason, TheScripts seems to have a habit of inserting spaces when it thinks a string is too long, or something.

[awayne]

Um... isn't it conceivable that your problem is caused by trying to check the month in the new row that you just inserted?

As for the gap, I wouldn't worry about it. For some reason, TheScripts seems to have a habit of inserting spaces when it thinks a string is too long, or something.

It stops before getting to the point of inserting any new row.

Also, my thought is that it'll insert the new row above the current row after it compares the two dates so hopefully there aren't any new (blank) rows when it continues comparing. Is my reasoning logical? I'm certainly open to suggestions.

[Killer42]

It stops before getting to the point of inserting any new row.

Also, my thought is that it'll insert the new row above the current row after it compares the two dates so hopefully there aren't any new (blank) rows when it continues comparing. Is my reasoning logical? I'm certainly open to suggestions.

Um... couldn't say. I haven't spent enough time on your code to really understand the issues, and have only been able to drop into this thread briefly.

One question, though - is the "Type mismatch error" still your problem? If so, I'd say concentrate on that and don't worry about your logic. You should be able to examine values at that point and see what it is that "mismatches".

At a guess, your cell is formatted as text rather than date. But I may well be getting Excel and Word muddled up, here. In any case, have you checked the value that you are passing the the month() function? And have you tried running it rhough a conversion such as CDate() or DateValue() or DateSerial()?

[awayne]

Um... couldn't say. I haven't spent enough time on your code to really understand the issues, and have only been able to drop into this thread briefly.

One question, though - is the "Type mismatch error" still your problem? If so, I'd say concentrate on that and don't worry about your logic. You should be able to examine values at that point and see what it is that "mismatches".

At a guess, your cell is formatted as text rather than date. But I may well be getting Excel and Word muddled up, here. In any case, have you checked the value that you are passing the the month() function? And have you tried running it rhough a conversion such as CDate() or DateValue() or DateSerial()?

I'm running it through a CDate conversion when it fills in the table in the following line:

'Submission date column.
myWDApp.ActiveDocument.Tables(1).Cell(Row:=irow, Column:=3).Range.Text = CDate(Format(rstl.Fields(5), "mm/dd/yyyy"))

[Killer42]

I'm running it through a CDate conversion when it fills in the table in the following line:

'Submission date column.
myWDApp.ActiveDocument.Tables(1).Cell(Row:=irow, Column:=3).Range.Text = CDate(Format(rstl.Fields(5), "mm/dd/yyyy"))

But, does Word actually understand the concept of date values, or does it simply place them in the table as text? I believe Word tables are somewhat less sophisticated than Excel.

In any case, it might be worth a try, to see what happens. And to make sure that you do know exactly what values you're working with.

[awayne]

But, does Word actually understand the concept of date values, or does it simply place them in the table as text? I believe Word tables are somewhat less sophisticated than Excel.

In any case, it might be worth a try, to see what happens. And to make sure that you do know exactly what values you're working with.

Doh!! You're right Word doesn't do date values. I modified the italized text in my code to just look at the first two characters (code below) and that works (at least so far)!!!

Thanks. Now I'm going to insert the month in the new row.

For rowcount = 4 To rstl.RecordCount + (rcount + 4)
 
If left(myWDApp.ActiveDocument.Tables(1).Cell(Row:=rowcount, Column:=3).Range.Text, 2) <> left(myWDApp.ActiveDocument.Tables(1).Cell(Row:=rowcount - 1, Column:=3).Range.Text, 2) Then
 
myWDApp.ActiveDocument.Tables(1).Range.Rows(rowcount).Select
myWDApp.ActiveDocument.Application.Selection.InsertRows (1)
 
rowcount = rowcount + 1
 
End If
 
Next rowcount
 

[Killer42]

Oh well, glad to see we've got you back on track. :)

Don't forget, if necessary you should still be able to use CDate (or other function) when pulling your "date" back out of the table. (Only if necessary, of course - if grabbing the first two characters works, then great. Just keep in mind the possibility of different regional settings.)

Anyway, let us know how it all works out.

[Killer42]

Oh, one little suggestion.

Just for readability (and easier future maintenance) of your code, it might be nice to move the whole month-extraction process (well, statement) into a function so that rather than things like left(myWDApp.ActiveDocument.Tables(1).Cell(Row:=ro wcount, Column:=3).Range.Text, 2) you can instead use something like MonthFromCell(3, rowcount).

This would have the added advantage that if you change the way you pull out the months in future, you'd only have to change it in one place.