Solved

Getting error 3001 when user name contains an apostrophe

Posted on 2004-10-11
3
265 Views
Last Modified: 2011-08-18
Iam getting an error 3001 when I run my code on a user that has an apostrphy in the last name. I've tried some of the tips suggested in several of these articles but still get the same problem. My code is listed below. Any help would be appriciated.

Thanks
samiam41

While Not rs3.EOF
    rs3.Find "Department='" & department_choice & "'"
    If rs2.EOF = False Then
        unfixed = rs2.Fields("First_Name")
        fixed = ParseString(unfixed, " ", 1)
        If Len(rs2.Fields("Last_Name")) < 9 And Len(fixed) < 9 Then
            format1bad = 9 - Len(rs2.Fields("Last_Name"))
            format1close = String(format1bad + 1, " ")
            format1good = rs2.Fields("Last_Name") & format1close
            If Len(fixed) < 9 Then
                 format2bad = 9 - Len(fixed)
                 format2close = String(format2bad + 1, " ")
                 format2good = fixed & format2close
                 Form6.List1.AddItem format1good & " " & format2good & Chr(9) & rs2.Fields("UNIX_ID")
            Else
            End If
0
Comment
Question by:samiam41
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
3 Comments
 
LVL 11

Expert Comment

by:pratap_r
ID: 12277463
can you please post more of the code...as far as i can see from the code you have given you are doing a select from the database, i dont see any problem with that unless you meant an ' in department_choice

if you did then try replacing ' with a '' (two apostrophe not a double quote), this will work for the last_name scenario also

Pratap
0
 
LVL 9

Author Comment

by:samiam41
ID: 12278365
Thanks for your help. Here is the entire code, not written by me but someone who is no longer here.

Public ynflag As String, fname, lname, uid, problem, repairdate, repairdesc, fixed
Public department_choice As String, answer_done, answer_unique, explain, unixid
Public phnum, startdate, dept
Public conn As New ADODB.Connection
Public conn2 As New ADODB.Connection
Public rs As New ADODB.Recordset
Public rs2 As New ADODB.Recordset
Public rs3 As New ADODB.Recordset
Public cmd As New ADODB.Command
Public cmd2 As New ADODB.Command
Public cmd3 As New ADODB.Command
Public unfixed As String
Public departmentname As String
Private Declare Function SetWindowPos Lib "user32" _
   (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
    ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
    ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Const HWND_BOTTOM = 1
Private Const HWND_NOTOPMOST = -2
Private Const HWND_TOP = 0
Private Const HWND_TOPMOST = -1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1

Private Declare Function GetActiveWindow Lib "user32" () As Long


Public Sub MakeWindowAlwaysTop(hwnd As Long)

 SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, _
   SWP_NOMOVE + SWP_NOSIZE

End Sub

Public Sub MakeWindowNotTop(hwnd As Long)

  SetWindowPos hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, _
     SWP_NOMOVE + SWP_NOSIZE

End Sub
Public Function startcall()
Load Form2
Load Form3
Load Form4
Form2.Hide
Form3.Hide
Form4.Hide
Call userver
startdate = Date
Call department
Do While department_choice = ""
    DoEvents
Loop
If department_choice = "OTHER" Then
    fname = InputBox("What is their First Name?")
    lname = InputBox("What is their Last Name?")
    unixid = InputBox("What is their Unix ID?")
    Form3.Hide
    Do Until Form3.Visible = False
    DoEvents
    Loop
Else
    Do Until Form2.Visible = False
        Form2.Hide
    Loop
    Form6.Show
    Call list
    Do While Form6.myid = ""
        DoEvents
    Loop
    rs2.MoveFirst
    rs2.Find "Unix_ID='" & Form6.myid & "'"
    unixid = rs2.Fields("UNIX_ID")
    phnum = rs2.Fields("Phone")
    dept = department_choice
    lname = rs2.Fields("Last_Name")
    fname = rs2.Fields("First_Name")
End If
End Function
Public Function listdepartment()
rs2.MoveFirst
rs2.Find "DepartmentName='" & Form3.lst_dept.Text & "'"
department_choice = Form3.lst_dept.Text
departmentname = rs2.Fields("DepartmentCode")
End Function
Public Function list()
rs2.MoveFirst
While Not rs3.EOF
    rs3.Find "Department='" & department_choice & "'"
    If rs2.EOF = False Then
        unfixed = rs2.Fields("First_Name")
        fixed = ParseString(unfixed, " ", 1)
        If Len(rs2.Fields("Last_Name")) < 9 And Len(fixed) < 9 Then
            format1bad = 9 - Len(rs2.Fields("Last_Name"))
            format1close = String(format1bad + 1, " ")
            format1good = rs2.Fields("Last_Name") & format1close
            If Len(fixed) < 9 Then
                 format2bad = 9 - Len(fixed)
                 format2close = String(format2bad + 1, " ")
                 format2good = fixed & format2close
                 Form6.List1.AddItem format1good & " " & format2good & Chr(9) & rs2.Fields("UNIX_ID")
            Else
            End If
        Else
'            If Len(fixed) < 9 Then
'                 format3bad = 9 - Len(fixed)
'                 format3close = String(format3bad, " ")
'                 format3good = fixed & format3close
'                 Form6.List1.AddItem (rs2.Fields("Last_Name")) & " " & format3good & Chr(9) & rs2.Fields("UNIX_ID")
'            Else
'            End If
            Form6.List1.AddItem (rs2.Fields("Last_Name")) & " " & fixed & Chr(9) & rs2.Fields("UNIX_ID")
        End If
        rs2.MoveNext
    End If
Wend
End Function
Public Function finish_call()
rs.MoveFirst
While Not rs.EOF
    If IsNull(rs!repair_description) Then
        closecall = 1
        rs!repair_description = "empty"
    End If
    rs.MoveNext
Wend
rs.MoveFirst
If rs.EOF = False Then
    If rs.BOF = False Then
        rs.Find "Record_Number = '" & Form5.mynumber & "'"
        Debug.Print (rs.Fields("Problem_Description"))
        rs.Update
        finish_repair = InputBox("Please type repair description")
        rs!repair_description = finish_repair
        rs!Repaired_By = getLoggedUserName
        rs!date_completed = Date
        rs.Update
    End If
End If
ynflag = "finish"
Call done
End Function
Private Sub cmd_autowrap_Click()
Call startcall
problem = "HP9000 text runs off the screen."
Form2.lbl_ready.Caption = "Have you set the autowrap option?"
Do Until Form6.Visible = False
    Form6.Hide
Loop
Call getanswer
Do While answer_done = ""
    DoEvents
Loop
repairdate = Date
repairdesc = answer_done
Call done

End Sub

Private Sub cmd_end_Click()
End
End Sub

Private Sub cmd_finish_Click()
Load Form5
Form5.Show
rs.MoveFirst
While Not rs.EOF
    rs.Find "Repair_Description = 'empty'"
    If rs.EOF <> True Then
        Form5.lst_unfinished.AddItem (rs.Fields("Record_Number")) & " " & (rs.Fields("Call_Date")) & " " & (rs.Fields("First_Name")) & " " & (rs.Fields("Last_Name")) & " " & (rs.Fields("Problem_Description"))
        rs.MoveNext
    Else
    End If
Wend
rs.MoveFirst
While Not rs.EOF
    rs.Find "Repair_Description = Null"
    If rs.EOF <> True Then
        Form5.lst_unfinished.AddItem (rs.Fields("Record_Number")) & " " & (rs.Fields("Call_Date")) & " " & (rs.Fields("First_Name")) & " " & (rs.Fields("Last_Name")) & " " & (rs.Fields("Problem_Description"))
        rs.MoveNext
    Else
    End If
Wend
    If Form5.lst_unfinished.ListCount = 0 Then
        MsgBox ("No open HelpDesk Calls")
        Call done
    Else
    End If

End Sub

Private Sub cmd_icon_Click()
Call startcall
problem = "Shortcuts are missing or incorrect."
Do Until Form6.Visible = False
    Form6.Hide
Loop
Form2.lbl_ready.Caption = "Have You restored the icons?"
Call getanswer
Do While answer_done = ""
    DoEvents
Loop
repairdate = Date
repairdesc = answer_done
Call done

End Sub

Private Sub cmd_lo2_Click()
Call startcall
problem = "User Logged on Twice"
Form2.lbl_ready.Caption = "Have you mastered off the user?"
Call getanswer
Do While answer_done = ""
    DoEvents
Loop
repairdate = Date
repairdesc = answer_done
Call done
End Sub

Private Sub cmd_lock_Click()
Call startcall
problem = "User locked out of network."
Do Until Form6.Visible = False
    Form6.Hide
Loop
Form2.lbl_ready.Caption = "Have you unlocked the user?"
Call getanswer
Do While answer_done = ""
    DoEvents
Loop
repairdate = Date
lname = rs2.Fields("Last_Name")
fname = fixed
repairdesc = answer_done
Call done
End Sub

Private Sub cmd_ontop_Click()
If cmd_ontop.Caption = "Not on Top" Then
    cmd_ontop.Caption = "On Top"
    Call MakeWindowAlwaysTop(hwnd)
ElseIf cmd_ontop.Caption = "On Top" Then
    cmd_ontop.Caption = "Not on Top"
    Call MakeWindowNotTop(hwnd)
End If
End Sub

Private Sub cmd_ost_Click()
Call startcall
problem = "Bad OST file."
Do Until Form6.Visible = False
    Form6.Hide
Loop
Form2.lbl_ready.Caption = "Have you deleted the OST File?"
Call getanswer
Do While answer_done = ""
    DoEvents
Loop
repairdate = Date
repairdesc = answer_done
Call done
End Sub

Private Sub cmd_pass_Click()
Call startcall
problem = "User forgot password."
Do Until Form6.Visible = False
    Form6.Hide
Loop
Form2.lbl_ready.Caption = "Have you changed the user's password?"
Call getanswer
Do While answer_done = ""
    DoEvents
Loop
repairdate = Date
repairdesc = answer_done
Call done
End Sub

Private Sub cmd_state_Click()
Call startcall
problem = "State keys are not functioning correctly."
Do Until Form6.Visible = False
    Form6.Hide
Loop
Form2.lbl_ready.Caption = "Have you set up STATE.MAP?"
Call getanswer
Do While answer_done = ""
    DoEvents
Loop
repairdate = Date
lname = rs2.Fields("Last_Name")
fname = fixed
repairdesc = answer_done
Call done

End Sub

Public Function userver()
End Function
Private Sub cmd_unique_Click()
Call startcall
anser_unique = ""
problem = txt_problem.Text
Form4.Show
Do While answer_unique = ""
    DoEvents
Loop
repairdate = Date
repairdesc = answer_unique
Call done
End Sub
Private Sub Form_Load()
Call MakeWindowAlwaysTop(hwnd)
conn.ConnectionString = _
    "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Persist Security Info=False;" & _
    "Data Source=\\jeffcoattny\D$\Help Desk\service.mdb"
conn.Open
conn2.ConnectionString = _
    "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Persist Security Info=False;" & _
    "Data Source=\\jcaointranet\D$\inetpub\jcaointranet\access_db\accessdb.mdb"
conn2.Mode = adModeRead
conn2.Open
cmd.CommandText = "Service_Records"
cmd.CommandType = adCmdTable
rs.Open "Service_Records", conn2, adOpenKeyset, adLockOptimistic, adCmdTable
cmd2.CommandText = "tblDepartment"
cmd2.CommandType = adCmdTable
cmd3.CommandText = "tblUser"
cmd3.CommandType = adCmdTable
rs2.Open "tblDepartment", conn2, adOpenKeyset, adLockOptimistic, adCmdTableDirect
rs3.Open "tblUser", conn2, adOpenKeyset, adLockOptimistic, adCmdTableDirect
Form1.Visible = True
Timer1.Interval = 1000
End Sub
Public Function user()
End Function
Public Function department()
Form1.Visible = False
Do Until Form1.Visible = False
    DoEvents
Loop
Form3.Visible = True
rs3.MoveFirst
While Not rs2.EOF
    Form3.lst_dept.AddItem (rs2.Fields("DepartmentName"))
    rs2.MoveNext
Wend
'    If rs3.EOF = False Then
'        unfixed = rs3.Fields("UserFirstName")
'        fixed = ParseString(unfixed, " ", 1)
'        If Len(rs3.Fields("UserLastName")) < 9 And Len(fixed) < 9 Then
'            format1bad = 9 - Len(rs3.Fields("UserLastName"))
'            format1close = String(format1bad + 1, " ")
'            format1good = rs3.Fields("UserLastName") & format1close
'            If Len(fixed) < 9 Then
'                 format2bad = 9 - Len(fixed)
'                 format2close = String(format2bad + 1, " ")
'                 format2good = fixed & format2close
'                 Form6.List1.AddItem format1good & " " & format2good & Chr(9) & rs3.Fields("HPLogin")
'            Else
'            End If
'        Else
'            If Len(fixed) < 9 Then
'                 format3bad = 9 - Len(fixed)
'                 format3close = String(format3bad, " ")
'                 format3good = fixed & format3close
'                 Form6.List1.AddItem (rs2.Fields("Last_Name")) & " " & format3good & Chr(9) & rs2.Fields("UNIX_ID")
'            Else
'            End If
'            'Form3.List1.AddItem (rs3.Fields("UserLastName")) & " " & fixed & Chr(9) & rs3.Fields("HPLogin")
'        End If
'        rs2.MoveNext
'    End If


End Function
Public Function done()
If ynflag = "" Then
    rs.AddNew
    rs.Update
    rs!Received_By = getLoggedUserName
    rs!call_date = startdate
    rs!caller_department = dept
    rs!problem_description = problem
    rs!Repaired_By = getLoggedUserName
    rs!date_completed = repairdate
    rs!repair_description = repairdesc
    rs!first_name = fname
    rs!Last_Name = lname
    rs.Update
   
Else
End If
ynflag = ""
Timer1.Interval = 60
Me.Show
Unload Form2
Unload Form3
Unload Form4
Unload Form5
Unload Form6
department_choice = ""
answer_done = ""
txt_problem.Text = ""
Form4.txt_solution.Text = ""
Form2.txt_explain.Text = ""
Form6.myid = ""
fixed = ""
End Function

Public Function getanswer()
Do Until Form3.Visible = False
    Form3.Hide
Loop
Form2.Show
End Function
Public Function explan()
received = getLoggedUserName
repairdate = Date
repairdesc = explain
Call done
End Function


Private Sub txt_problem_KeyPress(KeyAscii As Integer)
If KeyAscii = "13" Then
    Call cmd_unique_Click
End If
End Sub
0
 
LVL 11

Accepted Solution

by:
pratap_r earned 125 total points
ID: 12278417
you might want to replace the user input ' with '' in this line
    lname = InputBox("What is their Last Name?")

that i think should solve the problem.. if not can you tell me when exactly you are getting this error? if possible the line number. a stack trace would be helpful

Pratap
0

Featured Post

Get 15 Days FREE Full-Featured Trial

Benefit from a mission critical IT monitoring with Monitis Premium or get it FREE for your entry level monitoring needs.
-Over 200,000 users
-More than 300,000 websites monitored
-Used in 197 countries
-Recommended by 98% of users

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Whether you've completed a degree in computer sciences or you're a self-taught programmer, writing your first lines of code in the real world is always a challenge. Here are some of the most common pitfalls for new programmers.
Computer science students often experience many of the same frustrations when going through their engineering courses. This article presents seven tips I found useful when completing a bachelors and masters degree in computing which I believe may he…
Simple Linear Regression
Starting up a Project

615 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