Hello, I have some code that was tweaked for me by the great Capricorn1 of this very site which exports the selections of list box to MS Word. The code has two problems. First, when you select a multi-select field (populated in other forms with a listbox) an error 'Run-time error '13': Type mismatch' occurs. I know this type of field is not very popular around these parts, but I'd appreciate any help in potentially fixing this. Next, the exported word document repeats the first row of records twice but doesn't report any other rows (the source of this form doing the exporting is a query called qryAll). I'm attaching the code to this post and then a sample database as well. The form in question is 'MakeWordTable'.
Thanks for any comments,
Private Sub Command0_Click()
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") & ";"
FinalString = FinalString & myfield.Name & ";" & Nz(myfield.Properties("Caption"), "no caption") & ";"
Me.lstFields.RowSource = FinalString
Me.lstFields.ColumnCount = 2
Me.lstFields.ColumnWidths = 2.75 * 1440 & ";" & 3.25 * 1440
If Err.Number = 3270 Then 'no existing caption
FinalString = FinalString & myfield.Name & ";" & "no caption" & ";"
Private Sub Command2_Click()
Dim fieldlist As String, fldArr, j As Integer, fldCapList As String, CapArr
Dim nc As Long, rs As DAO.Recordset, strSql As String
Dim nr As Long
For X = 0 To lstFields.ListCount - 1
If lstFields.Selected(X) Then
fieldlist = fieldlist & "," & "[" & lstFields.Column(0, X) & "]"
fldCapList = fldCapList & "," & lstFields.Column(1, X)
If fieldlist = "" Then
MsgBox "You must select at least one field"
fieldlist = Mid(fieldlist, 2)
CapArr = Split(Mid(fldCapList, 2), ",")
strSql = "select " & fieldlist & " from qryAll"
Set rs = CurrentDb.OpenRecordset(strSql)
Set objword = CreateObject("Word.Application")
objword.Visible = True
Set d = objword.Documents.Add(DocumentType:=0)
Set t = d.content
t.PageSetup.Orientation = 1
nc = 1
For j = 0 To UBound(CapArr)
t.insertafter CapArr(j) & Chr(9)
nc = nc + 1
t.insertafter CapArr(j - 1) & Chr(13) & Chr(10)
nr = 1
Do Until rs.EOF
nr = nr + 1
For X = 0 To rs.Fields.Count - 1
t.insertafter rs.Fields(X).value & Chr(9)
t.insertafter rs.Fields(rs.Fields.Count - 1).value & Chr(13) & Chr(10)
t.ConvertToTable Separator:=1, NumColumns:=nc, NumRows:=nr, AutoFitBehavior:=0
.Style = "Table Grid"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False