Access 2007: Export to word VBA problem when using captions in listbox, HELP! (1 Viewer)

Bevos

New member
Local time
Today, 10:35
Joined
Apr 20, 2011
Messages
7
Hello, I have a database that users here have helped me improve on several occasions. One of these improvements was to change a listbox that exported the selected fields to a word document to show the field captions rather than the field names (ie. FName to 'First Name'). However, I'm not sure how the code for the export query needs to be changed to reflect this. I'm going to post the code for this item as well as the database. If you choose to download the database, the form that I am talking about here is 'makewordtable'.
When I run the code found in the attachment, I get an error "Run-time error '424' Object required" and the points to the line: For X = 0 To rs.Fields.Count - 2.
The code was working before the field list was changed to a caption list.
If any experts know how to work with this change I very much need the help.

Thanks so much, Bevo S.

Code:
Option Compare Database
 
Private Sub Command0_Click()
 
BuildValueList ("qryAll")
 
End Sub
 
Public Function BuildValueList(TableName As String)
On Error GoTo myerror
 
Dim FinalString As String
Dim db As Database
Dim rs As Recordset
Dim myfield As Field
 
Set db = CurrentDb
 
Set rs = db.OpenRecordset("Select * from " & TableName & " where 1 = 2;", dbOpenDynaset, dbSeeChanges)
 
For Each myfield In rs.Fields    
   FinalString = FinalString & Nz(myfield.Properties("Caption"), "no caption") & ";"
Next 
 
myfieldMe.lstFields.RowSource = FinalString
 
Exit Function
 
myerror:
If Err.Number = 3270 Then 'no existing caption    
   FinalString = FinalString & myfield.Name & ";" & "no caption" & ";"    
   Resume Next
End If
End Function
 
Private Sub Command2_Click()
Dim fieldlist As String
Dim nc As LongDim nr As Long
 
For X = 0 To lstFields.ListCount  
 
   If lstFields.Selected(X) Then    
      fieldlist = fieldlist & ", " & lstFields.Column(0, X)  
   End If
Next
 
If fieldlist = "" Then  MsgBox "You must select at least one field"  
   Exit Sub
End If
 
Set objword = CreateObject("Word.Application")
 
objword.Visible = True    
 
Set d = objword.Documents.Add(DocumentType:=0)    
 
Set t = d.content     
   
t.PageSetup.Orientation = 1nc = 1
 
For X = 0 To rs.Fields.Count - 2  
   t.insertafter rs.Fields(X).Name & Chr(9)  nc = nc + 1
Next
 
t.insertafter rs.Fields(rs.Fields.Count - 1).Name & Chr(13) & Chr(10)nr = 1
 
Do Until rs.EOF    
   nr = nr + 1    
   For X = 0 To rs.Fields.Count - 2      
      t.insertafter rs.Fields(X).value & Chr(9)    
   Next   
 
   t.insertafter rs.Fields(rs.Fields.Count - 1).value & Chr(13) & Chr(10)    
   rs.MoveNext
Loop    
 
t.WholeStory    
 
t.ConvertToTable Separator:=1, NumColumns:=nc, NumRows:=nr, AutoFitBehavior:=0    
 
With t.Tables(1)        
   .Style = "Table Grid"        
   .ApplyStyleHeadingRows = True        
   .ApplyStyleLastRow = False        
   .ApplyStyleFirstColumn = True        
   .ApplyStyleLastColumn = False    
End With
 
End Sub
 

Attachments

  • EE-ABS.accdb
    1.3 MB · Views: 132
Last edited by a moderator:

Users who are viewing this thread

Top Bottom