List Box Truncating strung Value

[txgeekgirl]

I have a group of list boxes where the items selected are strung together to form a comma seperated list. This is getting truncated at 75. I changed the table design from a Memo field to a textbox 255 and it still truncates at 75.

I read a post that it could look like this:

strFolders = """Folder 1, Folder 2, Folder 3, Folder 65, Folder 99, Folder771"""

However - what if the code looks like this?

strFolders = strFolders & Me.lbDeptFolders.Column(2, var1) & ","

 

[boblarson]

What is the rest of the code? How are you coming up with the var1 value? And I assume you are looping through something??

 

[txgeekgirl]

Hi Bob - you are quick today!

Correct - looping through the value of the list box.

Here's one list boxes code:

    '-------------SET DB Permissions----------------------------
    If flag = 1 And Me.lbDatabase.ItemsSelected.Count > 0 Then
        'Use global EmailGroups
        Dim var2 As Variant
                
        For Each var2 In Me.lbDatabase.ItemsSelected
            strDB = strDB & Me.lbDatabase.Column(2, var2) & ","
        Next var2
        strDB = Left(strDB, Len(strDB) - 1)
    Else
        If MsgBox("No Databases were chosen for this person - do you want to continue?", vbYesNo, "Database Permissions") = vbYes Then
            flag = 1
            strDB = "No Databases Selected"
        Else
            flag = 0
            Me.lbDatabase.SetFocus
        End If
    End If

Here's the truncated line it produced:
* Database(s): Users.ECI_EMR,Users.MH_EMR,Users.MRAuth_EMR,Users.MRProv_EMR,Users.SA_EM

 

[boblarson]

Oops, you left out the most important part. (I know I asked for the loop, so sue me )

Where are you getting this part:
* Database(s): Users.ECI_EMR,Users.MH_EMR,Users.MRAuth_EMR,Users. MRProv_EMR,Users.SA_EM

 

[txgeekgirl]

NOPE - That is what that string builds and shoots as an email. I was just showing you the stoppage at 75 char

 

[txgeekgirl]

If I can get this finished, I am posting as a how to - it's turned out to be a heck of a program. I am polishing off the code/commenting and trying to break it - because my boss promised me a trip to show it off...

 

[boblarson]

NOPE - That is what that string builds and shoots as an email. I was just showing you the stoppage at 75 char

You aren't showing me where you are actually using strDb though. That is the issue. Is it something that can handle the characters. That is what I want to see. The code to build it is fine. There is nothing wrong with it. But now we are down to what is consuming it.

 

[txgeekgirl]

Oh - I understand - It's getting thrown into a a sql statement and emailed.

Added to table here:

Sub AddEmpInfo()
Dim mySql As String
    mySql = "INSERT INTO NewStaffRequests(RequestType, SubmittedBy, DateReq, StaffID, NewStaff_F_Name, NewStaff_L_Name, DepartmentName, DeptRU, Location, BusinessPhone, Need_Email, Previous_Staffed_Position, "
    mySql = mySql & "PrevStaffID, PrevStaff_F_Name, PrevStaff_L_Name, Forward_Email, Transfer_E, Transfer_Iserv_Lic, EMRReader, EMRScanner, EMRChartCreator, EMREditor, "
    mySql = mySql & "DefaultPrinter, Need_NewIserv, Need_IservSig, EmailGroups, SharedFolders, Databases)"
    mySql = mySql & "SELECT 'Network Permissions Change' AS MyType, '" & userName & "' AS MySup, '" & [Forms]![NetworkPermissionsChange]![tbDate] & "' AS MyDate, " & [Forms]![NetworkPermissionsChange]![tbStaffID] & " AS MyStaffID, '"
    mySql = mySql & [Forms]![NetworkPermissionsChange]![tbFName] & "' AS MyFName, '" & [Forms]![NetworkPermissionsChange]![tbLName] & "' AS MyL_Name, '"
    mySql = mySql & Trim([Forms]![NetworkPermissionsChange]![tbDeptName]) & "' AS MyDName, '" & [Forms]![NetworkPermissionsChange]![cbRU] & "' AS MyDeptRU, '"
    mySql = mySql & [Forms]![NetworkPermissionsChange]![tbLocation] & "' AS MyLocation, '" & [Forms]![NetworkPermissionsChange]![tbWorkPhone] & "' AS MyPhone, '"
    mySql = mySql & [Forms]![NetworkPermissionsChange]![cbxEmail] & "' AS MyEmail, '" & [Forms]![NetworkPermissionsChange]![cbxPrevHeld] & "' AS MyPrevious_Staffed_Position, '"
    mySql = mySql & [Forms]![NetworkPermissionsChange]![cbPrevStaffID] & "' AS MyPrevStaffID, '" & [Forms]![NetworkPermissionsChange]![tbPrevFName] & "' AS MyPrevStaff_F_Name, '"
    mySql = mySql & [Forms]![NetworkPermissionsChange]![tbPrevLName] & "' AS MyPrevStaff_L_Name, '" & [Forms]![NetworkPermissionsChange]![cbPrevEmail] & "' AS MyForward_Email, '"
    mySql = mySql & [Forms]![NetworkPermissionsChange]![cbxEDrive] & "' AS MyTransfer_E, '" & [Forms]![NetworkPermissionsChange]![cbxIservLic] & "' AS MyTransfer_Iserv_Lic, '"
    mySql = mySql & [Forms]![NetworkPermissionsChange]![cbxEMR_Reader] & "' AS MyEMRReader, '" & [Forms]![NetworkPermissionsChange]![cbxEMR_Scanner] & "' AS MyEMRScanner, '"
    mySql = mySql & [Forms]![NetworkPermissionsChange]![cbxEMR_ChartCreator] & "' AS MyEMRChartCreator, '" & [Forms]![NetworkPermissionsChange]![cbxEMR_Editor] & "' AS MyEMREditor, '"
    mySql = mySql & PRT_Group & "' AS MyDefaultPrinter, '"
    mySql = mySql & [Forms]![NetworkPermissionsChange]![cbxNewIserv] & "' AS MyNewI, '" & [Forms]![NetworkPermissionsChange]![cbxIservSigner] & "' AS MyNewISig, '"
    mySql = mySql & strGroups & "' AS MyGroups, '" & strFolders & "' AS MyFolders, '" & strDB & "' AS MyDatabases ;"
    DoCmd.SetWarnings False
    DoCmd.RunSQL mySql
    DoCmd.SetWarnings True

Message set here:

Sub SubmitPermissionsChange()
    Dim mystr, myEmpInfo, Part1, myNeeds As String
    
    myRec = DMax("[ID]", "[NewStaffRequests]", "[StaffID] = '" & [Forms]![NetworkPermissionsChange]![tbStaffID] & "'")
    Me.tbMyRecord = myRec
    
    'Gather Emp Ifo into a readable statement
    myEmpInfo = "I am requesting a Network Account for my New Employee: " & DLookup("[StaffID]", "[NewStaffRequests]", "[ID] = " & myRec) & " - "
    myEmpInfo = myEmpInfo & DLookup("[NewStaff_F_Name]", "[NewStaffRequests]", "[ID] = " & myRec) & " " & DLookup("[NewStaff_L_Name]", "[NewStaffRequests]", "[ID] = " & myRec) & "."
    myEmpInfo = myEmpInfo & vbNewLine & vbNewLine & "My new staff will be assigned to RU: " & DLookup("[DeptRU]", "[NewStaffRequests]", "[ID] = " & myRec) & " - " & DLookup("[DepartmentName]", "[NewStaffRequests]", "[ID] = " & myRec)
    myEmpInfo = myEmpInfo & " located at " & DLookup("[Location]", "[NewStaffRequests]", "[ID] = " & myRec) & " and can be reached at phone number - " & DLookup("[BusinessPhone]", "[NewStaffRequests]", "[ID] = " & myRec) & "."
    
   'Was this a prev staffed position - gather and write this info
    If DLookup("[Previous_Staffed_Position]", "[NewStaffRequests]", "[ID] = " & myRec) = -1 Then
        Part1 = vbNewLine & "This position was previously held by: " & DLookup("[PrevStaffId]", "[NewStaffRequests]", "[ID] = " & myRec) & " - " & DLookup("[PrevStaff_F_Name]", "[NewStaffRequests]", "[ID] = " & myRec) & " "
        Part1 = Part1 & DLookup("[PrevStaff_L_Name]", "[NewStaffRequests]", "[ID] = " & myRec) & "."
        If DLookup("[Forward_Email]", "[NewStaffRequests]", "[ID] = " & myRec) = -1 Then
            Part1 = Part1 & vbNewLine & " * Please forward email from the Previous Staff Person to the New Staff."
        End If
        If DLookup("[Transfer_E]", "[NewStaffRequests]", "[ID] = " & myRec) = -1 Then
            Part1 = Part1 & vbNewLine & " * Please transfer the E: from the Previous Staff Person to the New Staff."
        End If
        If DLookup("[Transfer_Iserv_Lic]", "[NewStaffRequests]", "[ID] = " & myRec) = -1 Then
            Part1 = Part1 & vbNewLine & " * Please transfer the Iserv License from the Previous Staff Person to the New Staff."
        End If
    End If
    
      
    'Determine needs based on choices
    myNeeds = vbNewLine & vbNewLine & "NEEDS: "
    If DLookup("[Need_Email]", "[NewStaffRequests]", "[ID] = " & myRec) = -1 Then
        myNeeds = myNeeds & vbNewLine & " * Email Account "
    End If
    If DLookup("[Need_NewIserv]", "[NewStaffRequests]", "[ID] = " & myRec) = -1 Then
        myNeeds = myNeeds & vbNewLine & " * New Iserv License - I have attached a P.O. for this expense "
    End If
    If DLookup("[Need_IservSig]", "[NewStaffRequests]", "[ID] = " & myRec) = -1 Then
        myNeeds = myNeeds & vbNewLine & " * Needs Iserv PIN number "
    End If
    If DLookup("[EMRReader]", "[NewStaffRequests]", "[ID] = " & myRec) = -1 Then
        myNeeds = myNeeds & vbNewLine & " * EMR Reader "
    Else
        If DLookup("[EMRScanner]", "[NewStaffRequests]", "[ID] = " & myRec) = -1 Then
            myNeeds = myNeeds & vbNewLine & " * EMR Scanner "
        Else
            If DLookup("[EMRChartCreator]", "[NewStaffRequests]", "[ID] = " & myRec) = -1 Then
                myNeeds = myNeeds & vbNewLine & " * EMR Chart Creator "
                Else
                If DLookup("[EMREditor]", "[NewStaffRequests]", "[ID] = " & myRec) = -1 Then
                myNeeds = myNeeds & vbNewLine & " * EMR PDF Editor "
                End If
            End If
        End If
    End If
    If Not IsNull(DLookup("[DefaultPrinter]", "[NewStaffRequests]", "[ID] = " & myRec)) Then
        myNeeds = myNeeds & vbNewLine & " * Default Printer: " & DLookup("[DefaultPrinter]", "[NewStaffRequests]", "[ID] = " & myRec)
    End If
    If Not IsNull(DLookup("[EmailGroups]", "[NewStaffRequests]", "[ID] = " & myRec)) Then
        myNeeds = myNeeds & vbNewLine & " * Group(s): " & DLookup("[EmailGroups]", "[NewStaffRequests]", "[ID] = " & myRec)
    End If
    If Not IsNull(DLookup("[SharedFolders]", "[NewStaffRequests]", "[ID] = " & myRec)) Then
        myNeeds = myNeeds & vbNewLine & " * Shared Folder(s): " & DLookup("[SharedFolders]", "[NewStaffRequests]", "[ID] = " & myRec)
    End If
    If Not IsNull(DLookup("[Databases]", "[NewStaffRequests]", "[ID] = " & myRec)) Then
        myNeeds = myNeeds & vbNewLine & " * Database(s): " & DLookup("[Databases]", "[NewStaffRequests]", "[ID] = " & myRec) & vbNewLine
    End If
    mystr = myEmpInfo & Part1 & myNeeds
     
    If MsgBox("Is this correct? " & vbNewLine & mystr, vbYesNo, "Network Permissions Change Request") = vbYes Then
        Call SubmitEmail(mystr, CStr(myRec))
        MsgBox "Your request has been sent to Information Systems for processing."
        clearform
        DoCmd.Close
        DoCmd.SelectObject acForm, "Switchboard"
        DoCmd.Restore
    Else
        
        Me.tbStaffID.SetFocus
        
        DoCmd.SetWarnings False
        DoCmd.RunSQL "DELETE * FROM [NewStaffRequests] WHERE [ID] = " & myRec
        DoCmd.SetWarnings True
        
        Me.tbMyRecord = Null
        myRec = 0
        
        Exit Sub
    End If
            
End Sub

 

[txgeekgirl]

BOB - If there was a DUH emicon I would use it here - it was in the parsing on the code where Active Dir reads it! I have that fixed! I am so sorry I wasted your time - I just needed your Osmosis Jones!

 

[boblarson]

BOB - If there was a DUH emicon I would use it here - it was in the parsing on the code where Active Dir reads it! I have that fixed! I am so sorry I wasted your time - I just needed your Osmosis Jones!

Not a waste of time actually. Sometimes it takes some interaction with others to figure it out yourself. I have done that many times in my past with my own problems. I will start talking to someone about it and, in the course of explaining the situation, I will suddenly realize what the problem is. So, no worries there.

 

[txgeekgirl]

:d you rock bob!