• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 265
  • Last Modified:

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

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,
Bevo
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

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, 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
Next
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
Next
    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)
            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

Open in new window

EE-Example.accdb
0
Bevos
Asked:
Bevos
  • 3
  • 3
1 Solution
 
Rey Obrero (Capricorn1)Commented:
what have you done?
these codes worked perfectly...
0
 
BevosAuthor Commented:
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].
0
 
Rey Obrero (Capricorn1)Commented:
there is nothing wrong with the codes.

check the query  "qryALL"  it is returning duplicate values
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
BevosAuthor Commented:
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?

Bevo
0
 
Rey Obrero (Capricorn1)Commented:
run the query qryALL
see the result is duplicated
0
 
BevosAuthor Commented:
Correct as always Cap. Thanks for looking at this one even though you solved it previously.

Bevo
0

Featured Post

Upgrade your Question Security!

Add Premium security features to your question to ensure its privacy or anonymity. Learn more about your ability to control Question Security today.

  • 3
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now