Trapping Hyperlink Error
กระทู้เก่าบอร์ด อ.สุภาพ ไชยา

 350   4
URL.หัวข้อ / URL
Trapping Hyperlink Error

มีคนถามไว้ที่ 
 
http://www.access-programmers.co.uk/forums/showthread.php?s=&threadid=19946 
 
ดังนี้ 
I know how to trap standard MS Access errors where you can have the error trapping code 
search for a particular MS ACCess error number. However, how do you get a 
list of all possible MS Windows error codes so that external events can be 
trapped and resolved. 
 
For example, I ahve a hyperlink field on my form that stores a the PATH to a 
document ie. c:\my documents\thanks.doc If this document is moved or deleted,
 the MS Access application come sback with the following message :  
 
"Unable to open c:\my documents\thanks.doc. Cannot open specified file.  
 
I want to trap this error so I can display a different warning to the user. How is this
achieved? 
 
ต้องการที่จะแสดงข้อความที่กำหนดได้เองสำหรับบอกผู้ใช้เมื่อไม่มีไฟล์เป้าหมายที่อยู่ใน Hyperlink จะทำอย่างไร 
ไม่อยากได้คำเตือนที่ Access มีให้คือ 
"Unable to open c:\my documents\thanks.doc. Cannot open specified file.
 
 
ความคิดแรกที่วิ่งเข้ามาในหัวผมก็คือ จะตรวจหาไฟล์เป้าหมายว่ามีอยู่ในห้องที่ระบุไว้หรือไม่ ถ้าไม่มีให้แจ้งข้อความของเราเองเตือน แต่จะทำในฟีลด์ที่เป็นแบบ Hyperlink จะได้หรือเปล่า 
 
หรือจะไม่ใช้ Hyperlink แต่เก็บไฟล์ที่จะ link ไว้เป็น Text แล้วค่อยเรียกเปิดใน Web Browser Control ก็ได้ หรือจะเรียกไปเปิดใน Word เองก็ไม่มีปัญหา เพียงแต่ต้องไปเช็คดูก่อนว่ามีไฟล์เป้าหมายอยู่หรือเปล่า โดยใช้ Dir() 
 
มาถึงจุดนี้ทำให้ผมนึกถึงฟังก์ชันเปิดไฟล์ต่างๆ ที่ลงทะเบียนไว้ในเครื่องคอมฯ แล้ว ผมเอามาจากของ Microsoft เคยใชงานมาแล้วหลายครั้ง 
 
โค้ดมีดังนี้ครับ 
 
Declare Function ShellExecute Lib "shell32.dll" Alias _ 
    "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation _ 
    As String, ByVal lpFile As String, ByVal lpParameters _ 
    As String, ByVal lpDirectory As String, ByVal nShowCmd _ 
    As Long) As Long 
 
Global Const SW_SHOWNORMAL = 1 
 
Function StartDoc(DocName As String) 
 
On Error GoTo StartDoc_Error 
 
StartDoc = ShellExecute(Application.hWndAccessApp, "Open", DocName, _ 
    "", "C:\", SW_SHOWNORMAL) 
Exit Function 
 
StartDoc_Error: 
MsgBox "Error: " & Err & " " & Error 
Exit Function 
 
End Function 
 
ถ้าไฟล์เป้าหมายอยู่ในห้องเดียวกับไฟล์ db ที่เรียกใช้งาน ไม่ต้องระบุ path ก็ได้ครับ 
 
ผมเคยเอาไปตอบไว้ที่ http://www.quicktechusa.com/msgboard/wwwboard.pl?read=18079 ครั้งหนึ่งครับ 
      
คราวนี้ก็มาถึงการตรวจหาไฟล์เป้าหมายว่ามีอยู่หรือไม่ โดยใช้ Dir() ถ้ามีก็ให้เปิดไฟล์นั้นเลย แต่ถ้าไม่เจอ ก็ให้แจ้งบอกด้วยข้อความของเราเอง ทำได้ด้งนี้ครับ 
 
Public Function fOpenFile(strFileNamePath As String) 
If Len(strFileNamePath) <> 0 Then 
    If Dir(strFileNamePath) <> "" Then 
        StartDoc strFileNamePath 
        'FollowHyperlink strFileNamePath 
    Else 
        MsgBox "หาไฟล์ '" & strFileNamePath & "' ไม่เจอ", vbOKOnly, "Not found" 
        Exit Function 
    End If 
End If 
End Function 
 
แล้วความคิดที่ 1 หล่ะ จะทำได้มั๊ย ใช้หลังการเดียวกัน แต่จะซับซ้อนหน่อยหนึ่ง 
เริ่มจาก การไปแยกเอาชื่อไฟล์เป้าหมายออกจากฟีลด์ Hyperlink ที่เก็บชื่อไฟล์ไว้ ซึ่งจะอยู่ในรูปแบบเฉพาะ คือ มีเครื่องหมาย # กั้นหน้ากันหลังอยู่ ในหลายๆ รูปแบบดังนี้ 
#c:/workfile/text.txt# หรือ 
text.txt#c:/workfile/text.txt# หรือ 
mypresentation#d:/present.ppt#2 
 
ดูเพิ่มเติมเกี่ยวกับหัวข้อ HyperlinkAddress Property ใน Help ของ Access ได้ครับ 
 
จากตัวอย่างโค้ดข้างล่าง ผมจะใช้ Mid() และ Instr() เข้าช่วยกระเทาะเอาชื่อไฟล์ออกมาครับ ดังนี้ 
... 
    strFile = Me.SiteLink 
    strFile = Mid(strFile, InStr(strFile, "#") + 1) 
    strFile = Left(strFile, InStr(strFile, "#") - 1) 
... 
 
ผมเริ่มเขียนโค้ดดูในส่วนของ On Click ของ Text Box ที่เก็บฟีลด์ Hyperlink ปรากฎว่ายังมีข้อความของ Access แสดงขึ้นมาเหมือนเดิม แล้วจะทำอย่งไรดีหล่ะ ทำงัยให้สามารถหยุดข้อความของ Access ได้  
 
ผมนึกถึงคำสั่ง DoCmd.CancelEvent  
ลองใส่ไป ก็ยังไม่ได้ 
 
พอไปอ่าน Help ในหัวข้อ CancelEvent ดู เลยได้ไอเดียใหม่ ลองใช้กับ On MouseDown ของ Form ดู โดยใช้โค้ดนี้ 
 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 
Dim strFile As String 
'DoCmd.CancelEvent 
On Error GoTo myms 
If Me.ActiveControl = "SiteLink" Then 
If Me.SiteLink <> "" Or Not IsNull(Me.SiteLink) Then 
    strFile = Me.SiteLink 
    strFile = Mid(strFile, InStr(strFile, "#") + 1) 
    strFile = Left(strFile, InStr(strFile, "#") - 1) 
    Caption = strFile 
    If Dir(strFile) <> "" Then 
        'StartDoc strFile 
        FollowHyperlink strFile 
    Else 
myms: 
        MsgBox "หาไฟล์ '" & strFile & "' ไม่เจอ", vbOKOnly, "Not found" 
        Exit Sub 
        DoCmd.CancelEvent 
    End If 
End If 
End If 
End Sub 
 
ไม่เวิรค์แฮะ No Luck!!!! 
 
ผมคิดว่าคงเป็นเพราะบันทัดนี้ยังไม่ทำงานครับ 
... 
If Me.ActiveControl = "SiteLink" Then 
... 
เพราะโฟกัสยังไม่อยู่ใน Text Box เป้าหมายเลย 
 
เลยทดสอบดูว่า DoCmd.CancelEvent ใน On MouseDown จะหยุด Event อื่นถัดไปได้มั๊ย ที่ผมต้องการหยุดคือ On Click นั่นเอง 
 
ผมลองไปใช้กับ Text Box เป้าหมายดู 
 
Private Sub SiteLink_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 
    DoCmd.CancelEvent 
End Sub 
 
Bingo!! ใช้ได้ครับ 
 
ด้วยโค้ดข้างล่างนี้เลย 
 
Private Sub SiteLink_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 
Dim strFile As String 
DoCmd.CancelEvent 
If Me.SiteLink <> "" Or Not IsNull(Me.SiteLink) Then 
    strFile = Me.SiteLink 
    strFile = Mid(strFile, InStr(strFile, "#") + 1) 
    strFile = Left(strFile, InStr(strFile, "#") - 1) 
 
    If Dir(strFile) <> "" Then 
        'StartDoc strFile 
        FollowHyperlink strFile 
    Else 
        MsgBox "หาไฟล์ '" & strFile & "' ไม่เจอ", vbOKOnly, "Not found" 
        Exit Sub 
        DoCmd.CancelEvent 
    End If 
End If 
 
End Sub 
*** Edited by Supap Chaiya *** 1/4/2546 21:48:24

4 Reply in this Topic. Dispaly 1 pages and you are on page number 1

1 @R00506
ถ้าต้องการที่จะลบไฟล์ที่ Link ไว้ในฟีลด์ Hyperlink หล่ะ จะทำอย่างไร ดูคำตอบที่ http://www.access-programmers.co.uk/forums/showthread.php?s=&threadid=5476 และที่นี่เอง ที่ทำให้ผมเจอวิธีการหาชื่อของไฟล์ที่อยู่ใน Hyperlink ได้อีกวิธีหนึ่ง ซึ่งจะง่ายกว่าวิธีของผมด้วยซ้ำ คือ Me.HyperLinkTextBox.Hyperlink.Address
2 @R00507
และถ้าต้องการดูว่าไฟล์ที่ถูกลิ้งค์แบบ Hyperlink มีข้อมูลอื่นๆ อย่างบ้าง เช่นวันที่แก้ไขล่าสุด มีคนถามไว้ที่ http://www.access-programmers.co.uk/forums/showthread.php?s=&threadid=18029&highlight=hyperlink I have created a db that hyperlinks to many Word documents on a network drive. Along with the document hyperlink I also want to be able to show the date that the file was last modified on the form. Any ideas?? เมื่อผมเห็นคำถาม ทำให้ผมนึกถึงฟังก์ชันที่มากับ Access ตัวหนึ่งคือ FileDateTime() ครับ ผมจะยกตัวอย่างให้กับเหตุการณ์ที่เราเคลื่อน Mouse ไปยัง Text Box ของ Hyperlink แล้ให้แสดงวันเวลาที่ไฟล์ใน Hyperlink ถูกปรับปรุงแก้ไข ดังนี้ Private Sub SiteLink_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Caption = FileDateTime(Me.SiteLink.Hyperlink.Address) End Sub
3 @R00508
และถ้าต้องการจะส่งฟีลด์ Hyperlink ไปยัง Excel ผ่านทาง Query ทำอย่างไรให้มันเป็น Hyperlink เหมือนเดิม Hello, I am exporting a Query to Excel. One of the fields contains hyperlinks. However, in Excel the hyperlink no longer works. The text is there but is has a # on either end. Any ideas on how to keep the hyperlink functional in Excel? (http://www.access-programmers.co.uk/forums/showthread.php?s=&threadid=4391&highlight=hyperlink) ถ้าส่งโดยการ Export จาก Query ไปเป็น Excel โดยตรงจะไม่ได้ แต่ถ้าเปิด Query แล้วลากดำทั้งหมด Copy แล้วไป Paste ลง Excel เลย ก็จะได้ Hyperlink ติดไปด้วยครับ สีของ Hyperlink จะติดมาจากส่วนที่กำหนดใน Access ไว้ หรือให้สร้างเป็น Report เสียก่อน แล้วค่อย Export ให้ไปเป็นไฟล์ Excel ซึ่งจะง่ายและไวกว่าการส่งไปด้วยโค้ดมาก สีของ Hyperlink จะยึดตามที่กำหนดใน Excel
4 @R00509
ถ้าต้องการจะใช้โค้ดก็ได้ เริ่มจากการใช้ OutPutTo ก่อน เพราะสั้นดี ดังนี้ Sub test2() DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLS, "c:/test.xls" End Sub หรือจะเขียนแบบ Recordset ไปวางในฟีลด์เป้าหมายก็ได้ ดังนี้ Private Sub cmdExport2Excel_Click() Dim dbs As Database, rst As Recordset Dim I As Integer, J As Integer, X As Integer Dim Workbook As Object, xlApp As Object, Sheet As Object Dim strAppPath As String Set dbs = CurrentDb strAppPath = ap_AppDir + "query12.xls" Set rst = dbs.OpenRecordset("Query1") If Not rst.EOF Then rst.MoveLast rst.MoveFirst Set xlApp = GetObject(, "Excel.Application") Set xlApp = CreateObject("Excel.Application") Set Sheet = xlApp.workbooks.Open(strAppPath).sheets(1) 'Make Excel visible xlApp.Visible = True 'Run a macro named ClearAll, to clear all data 'xlApp.Application.Run "ClearAll" X = 1 For J = 1 To rst.RecordCount For I = 1 To rst.Fields.Count If I = rst.Fields.Count Then Sheet.Hyperlinks.Add Sheet.Cells(X + J, I), rst("Address") Else Sheet.Cells(X + J, I).Value = rst(I - 1) End If Sheet.Cells(X + J, I).Borders.LineStyle = 0 Sheet.Cells(X + J, I).Borders.LineStyle = 0 Next I rst.MoveNext Next J 'Print the Microsoft Excel spreadsheet. 'Sheet.PrintOut MsgBox "ปิด Excel ได้", vbOKOnly 'Close workbook without saving. xlApp.activeworkbook.Saved = True xlApp.activeworkbook.Close Set Sheet = Nothing xlApp.Quit Set xlApp = Nothing Else MsgBox "ไม่มีข้อมูล", vbOKOnly, "No Records!" End If Set rst = Nothing Set dbs = Nothing End Sub
@ ประกาศใช้งานเว็บบอร์ดใหม่ => บอร์ดเรียนรู้ Access สำหรับคนไทย
แล้วจะใส่ลิ้งอ้างอิงมาที่โพสต์เก่านี้หรือไม่ก็ตามสะดวกครับ
Time: 0.0433s