Results 1 to 8 of 8
  1. #1
    3 Star Lounger
    Join Date
    Sep 2002
    Posts
    294
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Problems with code (2000)

    The code listed below works. but it seems to not do a couple of things.
    The code is an improvement on the previous code, in that it searches the whole of a table (Documents) and then checks all of the links for a valid path.

    The bits that don't seem to work when you type in the correct word into the search box....... (The search box has 2 special words, 'hyperlinksearch' and 'showerrors', any other word then acts as a filter on the forms contents.

    1) The form 'frm_hyperlinklook' is not displaying, > <font color=blue>DoCmd.OpenForm "frm_Hyperlinkcheck", acNormal</font color=blue>

    2) I wanted to put the document that is being checked into the text box (and maybe count up the errors) on this form as it loops. > <font color=blue>Forms![frm_Hyperlinklook]![Current_File] = doc_number</font color=blue> I think this bit is ok. but i guess its not showing because of the form not showing..

    3) When the Reference numbers are written to the table, and you then show a subreport that is linked to this table, you will only see what was written to the table the previous time you opened the table. so i guess i need some sort of refresh in the code ?

    4) The table itself, with regard to the document numbers, isn't sorted. so is there a way, in code, to sort the table ?

    The rest of it appears to work ok..


    <font color=blue>'---------------Run search to check for missing hyperlinks---------------------------------------------------------------------------------

    Private Sub Search_Box_Exit(Cancel As Integer)

    If Me![Search_Box] = "hyperlinkcheck" Then
    On Error Resume Next
    Me![Search_Box] = ""

    DoCmd.OpenForm "frm_Hyperlinkcheck", acNormal

    Dim strSql As String, doc_name As String, lgt As Integer, doc_loc As String, doc_loc2 As String
    Dim pos As Integer, doc_number As String, lp As Integer
    Dim strSql2 As String, rst As Recordset

    strSql2 = "SELECT * FROM Documents"
    Set rst = CurrentDb.OpenRecordset(strSql2)

    Do While Not (rst.EOF)
    doc_loc = (rst![Document Link])
    doc_number = (rst![Reference Number])

    Forms![frm_Hyperlinklook]![Current_File] = doc_number

    lgt = Len(doc_loc)
    pos = 0

    While pos = 0
    lgt = lgt - 1
    If Mid(doc_loc, lgt, 1) = "/" Or Mid(doc_loc, lgt, 1) = "" Then
    pos = lgt
    End If
    Wend

    doc_loc2 = Mid(doc_loc, pos + 1)
    lgt = Len(doc_loc2)
    doc_loc2 = Left(doc_loc2, lgt - 1)
    doc_loc2 = "R:FACTORYTQMSTqms_Documents" & doc_loc2

    If Dir(doc_loc2) = "" Then
    strSql = "INSERT INTO tblFileErrors ( Problem ) Values (" & Chr(34) & doc_number & Chr(34) & ")"
    CurrentDb.Execute strSql, dbFailOnError
    End If
    rst.MoveNext

    Loop

    rst.Close
    Set rst = Nothing
    End If

    '-------------------------------------------------------------------------------------------------------------------------------------------------------

    If Me![Search_Box] = "showerrors" Then
    Me.Doc_Library_Subreport.Form.Visible = False
    Me.Allocated_Subreport.Form.Visible = False
    Me.Show_Errors.Form.Visible = True
    Me![Search_Box] = ""
    End If

    Doc_Library_Subreport.Form.Filter = "[Document Link] Like " & Chr(34) & "*" & [Search_Box] & "*" & Chr(34)
    Doc_Library_Subreport.Form.FilterOn = True
    Me![Search_Box] = ""

    End Sub</font color=blue>

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Problems with code (2000)

    Steve,

    I'll have a closer look at your code later on, if I can find time. For the moment, I have one remark: near the beginning of the code, you have On Error Resume Next. This means that you'll never know if an error occurred. You should use On Error Resume Next only in specific circumstances where you will inspect the Err object to see if an error occurred, not as a catch-all to prevent error messages. I recommend commenting it out for the time being, and seeing what error messages Access throws at you.

  3. #3
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Problems with code (2000)

    1) and 2) You (try to) open the form frm_HyperlinkCheck but later refer to Forms!frm_HyperlinkLook. This is typically one of those things that would cause an error message if you didn't have On Error Resume Next.

    I suspect that frmHyperlinkLook is the correct name. So DoCmd.OpenForm "frm_HyperlinkCheck" fails, as does Forms!frmHyperlinkLook!... since that form hasn't been opened.

    3) If a subform shows out-of-date record, try requerying it: <subform name>.Requery (substitute the name of the subform control)

    4) Tables are never sorted in Access, the records are stored in the order they were added. If there is a primary key, the records will by default be displayed sorted on the primary key. If you want to sort records in a (sub)form, either create a query that sorts the records the way you want and use that as Record Source, or set the OrderByOn and OrderBy properties of the form.

  4. #4
    3 Star Lounger
    Join Date
    Sep 2002
    Posts
    294
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Problems with code (2000)

    Yep Hans, removing the error trap things became clear. the form now shows, but i'm having to add a bit of extra code to cope
    with NULLS etc, that i didn't have to before.

    Testing it now.. i added this to the code > <font color=blue>Forms![frm_Hyperlinklook].Refresh</font color=blue>

    its updating.. but (this is hard to describe), the outline of the form shows, and the numbers update, but the form body is see-through !

    <img src=/S/bash.gif border=0 alt=bash width=35 height=39>

    <font color=blue> '---------------Run search to check for missing hyperlinks-------------------------------------------------------------------

    Private Sub Search_Box_Exit(Cancel As Integer)

    If Me![Search_Box] = "hyperlinkcheck" Then
    Me![Search_Box] = ""

    DoCmd.OpenForm "frm_Hyperlinklook", acNormal

    Dim strSql As String, doc_name As String, lgt As Integer, doc_loc As Variant, doc_loc2 As String
    Dim pos As Integer, doc_number As Variant, lp As Integer, Issue_Number As Integer
    Dim strSql2 As String, rst As Recordset, numberoferrors As Integer


    strSql2 = "SELECT * FROM Documents"
    Set rst = CurrentDb.OpenRecordset(strSql2)

    Do While Not (rst.EOF)
    doc_loc = (rst![Document Link])
    Issue_Number = (rst![Issue Number])

    If IsNull(doc_loc) Then
    doc_loc = "/Blank Field"
    End If

    doc_number = (rst![Reference Number])

    Forms![frm_Hyperlinklook]![Current_File] = doc_number
    Forms![frm_Hyperlinklook]![Text5] = numberoferrors
    Forms![frm_Hyperlinklook].Refresh


    lgt = Len(doc_loc)
    pos = 0

    While pos = 0
    lgt = lgt - 1
    If Mid(doc_loc, lgt, 1) = "/" Or Mid(doc_loc, lgt, 1) = "" Then
    pos = lgt
    End If
    Wend

    doc_loc2 = Mid(doc_loc, pos + 1)
    lgt = Len(doc_loc2)
    doc_loc2 = Left(doc_loc2, lgt - 1)
    doc_loc2 = "R:FACTORYTQMSTqms_Documents" & doc_loc2

    If Dir(doc_loc2) = "" And Issue_Number <> 0 Then
    strSql = "INSERT INTO tblFileErrors ( Problem ) Values (" & Chr(34) & doc_number & Chr(34) & ")"
    CurrentDb.Execute strSql, dbFailOnError
    numberoferrors = numberoferrors + 1
    End If
    rst.MoveNext

    Loop

    rst.Close
    Set rst = Nothing
    End If

    '----------------------------------------------------------------------------------------------------------------------------------------

    If Me![Search_Box] = "showerrors" Then
    Me.Doc_Library_Subreport.Form.Visible = False
    Me.Allocated_Subreport.Form.Visible = False
    Me.Show_Errors.Form.Visible = True
    Me![Search_Box] = ""
    End If

    Doc_Library_Subreport.Form.Filter = "[Document Link] Like " & Chr(34) & "*" & [Search_Box] & "*" & Chr(34)
    Doc_Library_Subreport.Form.FilterOn = True
    Me![Search_Box] = ""

    End Sub</font color=blue>

  5. #5
    3 Star Lounger
    Join Date
    Sep 2002
    Posts
    294
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Problems with code (2000)

    Well its all up and working now Hans. apart from one problem, the tbl_Hyperlinklook form, which opens when this code is run, is see through!
    I've attached a screen shot to give an idea.

    I refresh the form every loop.


    <font color=blue>Private Sub Search_Box_Exit(Cancel As Integer)

    '---------------Run search to check for missing hyperlinks----------------------------------------------------------------
    'On Error Resume Next

    If Me![Search_Box] = "hyperlinkcheck" Then
    Me![Search_Box] = ""

    DoCmd.OpenForm "frm_Hyperlinklook", acNormal
    Forms![frm_Hyperlinklook].SetFocus
    Dim strSql As String, doc_name As String, lgt As Integer, doc_loc As Variant, doc_loc2 As String
    Dim pos As Integer, doc_number As Variant, lp As Integer, Issue_Number As Variant
    Dim strSql2 As String, rst As Recordset, numberoferrors As Integer, Myloop As Integer

    strSql2 = "SELECT * FROM Documents"
    Set rst = CurrentDb.OpenRecordset(strSql2)

    Do While Not (rst.EOF)

    doc_loc = (rst![Document Link])
    If IsNull(doc_loc) Then
    doc_loc = "/Blank Field"
    End If

    Issue_Number = (rst![Issue Number])
    If IsNull(Issue_Number) Then
    Issue_Number = 1
    End If


    doc_number = (rst![Reference Number])
    If IsNull([doc_number]) Then
    doc_number = "No Number Set"
    End If

    Forms![frm_Hyperlinklook]![Current_File] = doc_number
    Forms![frm_Hyperlinklook]![numberof] = numberoferrors
    <font color=red>Forms![frm_Hyperlinklook].Refresh</font color=red>


    lgt = Len(doc_loc)
    pos = 0
    Myloop = lgt

    MeLoop:
    Myloop = Myloop - 1

    If Myloop = 1 Then pos = 1

    If Mid(doc_loc, Myloop, 1) = "/" Or Mid(doc_loc, Myloop, 1) = "" Then
    pos = Myloop
    End If
    If pos = 0 Then GoTo MeLoop



    If pos < 1 Then pos = 1

    doc_loc2 = Mid(doc_loc, pos + 1)
    lgt = Len(doc_loc2)
    doc_loc2 = Left(doc_loc2, lgt - 1)
    doc_loc2 = "R:FACTORYTQMSTqms_Documents" & doc_loc2

    If Dir(doc_loc2) = "" And Issue_Number <> 0 Then
    strSql = "INSERT INTO tblFileErrors ( Problem ) Values (" & Chr(34) & doc_number & Chr(34) & ")"
    CurrentDb.Execute strSql, dbFailOnError
    numberoferrors = numberoferrors + 1
    End If
    rst.MoveNext

    Loop

    rst.Close
    Set rst = Nothing
    End If

    '-------------------------------------------------------------------------------------------------------------------------------------------------

    If Me![Search_Box] = "showerrors" Then
    Me.Doc_Library_Subreport.Form.Visible = False
    Me.Allocated_Subreport.Form.Visible = False
    Me.Show_Errors.Form.Visible = True
    Me.Show_Errors.Form.Requery
    Me![Search_Box] = ""
    End If

    Doc_Library_Subreport.Form.Filter = "[Document Link] Like " & Chr(34) & "*" & [Search_Box] & "*" & Chr(34)
    Doc_Library_Subreport.Form.FilterOn = True
    Me![Search_Box] = ""


    End Sub</font color=blue>
    Attached Images Attached Images

  6. #6
    3 Star Lounger
    Join Date
    Sep 2002
    Posts
    294
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Problems with code (2000)

    forgot to mention, the tbl_hyperlinkslook form, has this code added to its on load property to change its color to yellow.

    I took it out at one point but it still did it.



    Private Sub Form_Load()
    Detail.BackColor = vbYellow
    Label0.ForeColor = vbRed
    End Sub

  7. #7
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Problems with code (2000)

    It's hard to say what causes this; it might be due to your video card. Try inserting Forms![frm_Hyperlinklook].Repaint after the Refresh.

  8. #8
    3 Star Lounger
    Join Date
    Sep 2002
    Posts
    294
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Problems with code (2000)

    Yup Hans, that worked. its a bit 'jittery' but it is now visible..

    cheers m8, another <img src=/S/bravo.gif border=0 alt=bravo width=16 height=30> i owe you. (you realise your gonna get seriously drunk at some point) <img src=/S/clapping.gif border=0 alt=clapping width=19 height=23>

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •