Strange behavior in export to word VBA from Access Form (duplication of row, failure in multi-select listbox)

Posted on 2011-05-04
Last Modified: 2012-05-11
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()
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") & ";"
    FinalString = FinalString & myfield.Name & ";" & Nz(myfield.Properties("Caption"), "no caption") & ";"
Next myfield

Me.lstFields.RowSource = FinalString
Me.lstFields.ColumnCount = 2
Me.lstFields.ColumnWidths = 2.75 * 1440 & ";" & 3.25 * 1440
Exit Function

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, 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)
  End If
If fieldlist = "" Then
  MsgBox "You must select at least one field"
  Exit Sub
End If
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
    With t.Tables(1)
        .Style = "Table Grid"
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
    End With

End Sub

Open in new window

Question by:Bevos
    LVL 119

    Expert Comment

    by:Rey Obrero
    what have you done?
    these codes worked perfectly...

    Author Comment

    Haha... I'm sorry. I actually cut and paste the code you posted and used it here (with the exception of the filter) to strSQLquery.  But even without that it still turns up this error in multi-value fields.  I made sure none of the field names had any spaces etc that could be causing errors.  It could have to do with the table structure? Right now all tables are set up as children of 1 parent table with a PK of [CallNumber].
    LVL 119

    Expert Comment

    by:Rey Obrero
    there is nothing wrong with the codes.

    check the query  "qryALL"  it is returning duplicate values

    Author Comment

    The query seems to be behaving fine.  All fields are reported as they are in the underlying tables.  Is there something else I should check?

    LVL 119

    Accepted Solution

    run the query qryALL
    see the result is duplicated

    Author Comment

    Correct as always Cap. Thanks for looking at this one even though you solved it previously.


    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    Highfive Gives IT Their Time Back

    Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

    This script will sweep a range of IP addresses (class c only, and report to a log the version of office installed. What it does: 1.)      Creates log file in the directory the script is run from (if it doesn't already exist) 2.)      Sweep…
    Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
    In Microsoft Access, learn the trick to repeating sub-report headings at the top of each page. The problem with sub-reports and headings: Add a dummy group to the sub report using the expression =1: Set the “Repeat Section” property of the dummy…
    In Microsoft Access, learn how to use Dlookup and other domain aggregate functions and one method of specifying a string value within a string. Specify the first argument, which is the expression to be returned: Specify the second argument, which …

    759 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    11 Experts available now in Live!

    Get 1:1 Help Now