FC2ブログ

スポンサーサイト 


上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

ハイパーリンクって、、、セキュリティは 


旧記事掲載:2010/01/30

クリックして他のウィンドウにXXを表示したいっていう時に、
便利なものとしてハイパーリンクというものがあります。

テーブルのフィールドの型にもあるので、
使いこなせれば、そこそこ面白いものを作ることができると思います。

回答する時も、まずはじめにハイパーリンクを紹介していますが、
自分では、、、というと、ハイパーリンクは使っていません。
編集しにくいとか、データを扱いにくいとか、、、私の中で違和感があったので。

ハイパーリンクについては、以下を参照してください。

ハイパーリンクについて
http://office.microsoft.com/ja-jp/access/HP051888171041.aspx


そこで、以下のようなサンプルを作ってみました。

kSample93_1

1)ハイパーリンクそのものの項目
2)文字列をハイパーリンクの様に扱う
2-1)コマンドボタンのハイパーリンクアドレスに都度設定
2-2)FollowHyperlink で起動
2-3)CreateObject("Shell.Application").ShellExecute で起動
2-4)API の ShellExecute で起動

Shell関数で起動という方法もありますが、
起動プログラムまでのパスを記述しないといけないこともあり、私には面倒。
(パスが一意に決まっていれば楽なのかも)

私は 2-4)で実現しています。

起動する時のセキュリティについては、詳しくはないのですが、さわりだけでも。
私は「低」にしているので、あまり引っかからないのですが、
それでもあ~だこ~だメッセージが出る時ありますね

デジタル署名について
http://office.microsoft.com/ja-jp/access/HP010397921041.aspx

の後半に記述されている(AutomationSecurity プロパティをいじる)
VBSファイル云々で回避できるようですが、注意事項があり、、、理解できてません。

後、データを検索できるように検索機能も設け、簡単な知識データベースとして使えるようになってます。

フォームのプロパティをいじる他は、すべてVBA記述になってます。
 
テーブルは1つ「T1」を用意します。
フィールドは、an、src1、src2、memo1
an: オートナンバ
src1: ハイパーリンク型
src2: テキスト型
memo1: メモ型


作り方)

・テーブルは上記を参考に作成します。

・作成するフォームは「F1」「F2」の2つ。
「F1」:テーブル「T1」を元に単票形式で作成後、既定のビューを帳票フォームへ変更したもの
「F2」:ハイパーリンク型データを分割入力するためのフォーム

・フォーム「F1」

フォームウィザードで、テーブル「T1」の src1、src2、memo1 を表示するように単票形式で作成後、
既定のビューを帳票フォームに変更します。
詳細部分のテキストボックスラベル部分の表示内容を意味のある言葉に変更します。
フォームヘッダ部に、
検索用テキストボックス「txt1」、スペース区切りで複数指定できるようにし、
それぞれを src1、src2、memo1 でヒットするかを処理するようにします。
複数指定時「AND」なのか「OR」なのかを指定させるコマンドボタン「btn1」
(今回は表示文字で判別するので、トグルボタンのON/OFF判別は使わない)
検索実行用にコマンドボタン「btn2」を配置します。

テキストに記述した内容を起動するために、
コマンドボタンのハイパーリンク起動用に、コマンドボタン「btn_hyper」
オプショングループ「op1」に値1~3でトグルボタン配置。上から
FollowHyperlink 用
Shell.Application 用
API ShellExecute 用
として、やっている内容を表示するためのラベル「lab1」を配置します。

「btn_hyper」「op1」「lab1」は、レコード移動時を主に、src2の内容により表示/非表示を制御します。

フォーム「F1」への記述内容
Const FIXAND = "AND"
Const FIXOR = "OR"

Private Sub OptVisSet(iSel As Integer, bVal As Boolean)
  Me.op1.Visible = bVal
  Me.lab1.Visible = bVal
  Me.btn_hyper.Visible = bVal
  Me.op1 = 0
  Me.lab1.Caption = ""
  If (bVal = True) Then
    If (iSel = 0) Then
      Me.btn_hyper.HyperlinkAddress = Me.src2
    Else
      Me.btn_hyper.HyperlinkAddress = Me.src2.OldValue
    End If
  End If
End Sub

Private Sub src2Switch()
  If (Len(Nz(Me.src2)) = 0) Then
    Call OptVisSet(0, False)
  Else
    Call OptVisSet(0, True)
  End If
End Sub

Private Sub Form_Load()
  Me.btn1.Caption = FIXAND
End Sub

Private Sub Form_Current()
  Call src2Switch
End Sub

Private Sub Form_Undo(Cancel As Integer)
  If (Len(Nz(Me.src2.OldValue)) = 0) Then
    Call OptVisSet(1, False)
  Else
    Call OptVisSet(1, True)
  End If
End Sub

Private Sub btn1_Click()
  If (Me.btn1.Caption = FIXAND) Then
    Me.btn1.Caption = FIXOR
  Else
    Me.btn1.Caption = FIXAND
  End If
End Sub

Private Sub btn2_Click()
  Dim vTxt As Variant
  Dim vTmp As Variant
  Dim sAndOr As String
  Dim sWhere As String

  sAndOr = " " & Me.btn1.Caption & " "
  sWhere = ""
  vTxt = Split(Trim(Nz(Me.txt1)), " ")
  For Each vTmp In vTxt
    If (Len(Nz(vTmp)) > 0) Then
      sWhere = sWhere & sAndOr & "("
      sWhere = sWhere & "([src1] Like '*" & vTmp & "*')"
      sWhere = sWhere & " OR ([src2] Like '*" & vTmp & "*')"
      sWhere = sWhere & " OR ([memo1] Like '*" & vTmp & "*')"
      sWhere = sWhere & ")"
    End If
  Next
  If (Len(sWhere) > 0) Then
    Me.Filter = Mid(sWhere, Len(sAndOr) + 1)
    Me.FilterOn = True
  Else
    Me.FilterOn = False
    Me.Filter = ""
  End If
End Sub

Private Sub btn_hyper_Click()
  Dim sMsg As String

  sMsg = "事前に以下を設定" & vbCrLf & vbCrLf
  sMsg = sMsg & "Me.btn_hyper.HyperlinkAddress = _" & vbCrLf
  sMsg = sMsg & " """ & Me.src2 & """"
  Me.lab1.Caption = sMsg
End Sub

' 入力されたテキストが単発のファイル名なら、アクセスを起動したパスを付加
Private Sub op1_Click()
  Dim sTmp As String
  Dim sMsg As String

  sTmp = Me.src2
  If ((InStr(sTmp, "\") = 0) And (InStr(sTmp, "/") = 0) _
    And (Left(sTmp, 7) <> "mailto:")) Then
    sTmp = CurrentProject.Path & "\" & sTmp
  End If

  sMsg = ""
  Select Case Me.op1
    Case 1
      Application.FollowHyperlink sTmp
      sMsg = sMsg & vbCrLf
      sMsg = sMsg & "Application.FollowHyperlink _" & vbCrLf
      sMsg = sMsg & " """ & sTmp & """"
    Case 2
      CreateObject("Shell.Application").ShellExecute sTmp
      sMsg = sMsg & vbCrLf
      sMsg = sMsg & "CreateObject(""Shell.Application"").ShellExecute _" & vbCrLf
      sMsg = sMsg & " """ & sTmp & """"
    Case 3
      Call appShellExecute(sTmp)
      sMsg = sMsg & "Const SW_SHOWNORMAL = 1" & vbCrLf & vbCrLf
      sMsg = sMsg & "ShellExecute(0, ""OPEN"", _" & vbCrLf
      sMsg = sMsg & " """ & sTmp & """, """", """", SW_SHOWNORMAL)"
  End Select
  Me.lab1.Caption = sMsg
End Sub

Private Sub src1_DblClick(Cancel As Integer)
  DoCmd.OpenForm "F2"
  Cancel = True
End Sub

Private Sub src2_AfterUpdate()
  Call src2Switch
End Sub

Private Sub src2_DblClick(Cancel As Integer)
  Dim sFullPath As String
  Dim sFileName As String

  If (appFileNameGet(Me.hwnd, "ファイル指定", sFullPath, sFileName)) Then
    Me.src2.Text = sFullPath
    Me.src2.SelStart = Len(sFullPath)
    Cancel = True
  End If
End Sub

 
ここで、ハイパーリンク項目の編集の仕方って、私自身できていないので、
編集用のフォームとして「F2」を用意しています。

kSample93_2

ハイパーリンクのラベル部分とか、未入力/編集状態時のダブルクリックで、
「F2」を起動できるようにしています。

ハイパーリンク型内部は "#" で区切られた4つの部位から構成されているので
それぞれを単独で入力できるようにした非連結のフォーム構成になります。

フォーム「F2」への記述内容
Dim RetCtl As TextBox

Private Sub Form_Load()
  Me.txt1.SetFocus
  Me.btn1.Visible = False
End Sub

Private Sub Form_Open(Cancel As Integer)
  Dim vTmp As Variant
  Dim i As Integer

  On Error Resume Next
  Set RetCtl = Screen.ActiveControl
  If (Not RetCtl Is Nothing) Then
    vTmp = Split(Nz(RetCtl), "#")
    For i = 0 To UBound(vTmp)
      If (i > 3) Then Exit For
      Me("txt" & i + 1) = vTmp(i)
    Next
    For i = 1 To 4
      Me("txt" & i).Tag = Nz(Me("txt" & i))
    Next
  End If
End Sub

Private Sub TxtCheck()
  Dim bChange As Boolean
  Dim i As Integer

  bChange = False
  For i = 1 To 4
    If (Me("txt" & i).Tag <> Nz(Me("txt" & i))) Then
      bChange = True
      Exit For
    End If
  Next
  Me.btn1.Visible = bChange
End Sub

Private Sub txt1_AfterUpdate()
  Call TxtCheck
End Sub
Private Sub txt2_AfterUpdate()
  Call TxtCheck
End Sub
Private Sub txt3_AfterUpdate()
  Call TxtCheck
End Sub
Private Sub txt4_AfterUpdate()
  Call TxtCheck
End Sub

Private Sub txt2_DblClick(Cancel As Integer)
  Dim sFullPath As String
  Dim sFileName As String

  If (appFileNameGet(Me.hwnd, "ファイル指定", sFullPath, sFileName)) Then
    Me.txt2.Text = sFullPath
    Me.txt2.SelStart = Len(sFullPath)
    Cancel = True
  End If
End Sub

Private Sub btn1_Click()
  Me.Visible = False
  If (Not RetCtl Is Nothing) Then
    RetCtl.Text = Nz(Me.txt1) & "#" & Nz(Me.txt2) _
            & "#" & Nz(Me.txt3) & "#" & Nz(Me.txt4)
    RetCtl.SelStart = Len(RetCtl.Text)
  End If
  Call btn2_Click
End Sub

Private Sub btn2_Click()
  DoCmd.Close acForm, Me.Name, acSaveNo
End Sub

 
「F1」でのテキスト部分、「F2」でのアドレス部分のダブルクリック時に、
ファイルを選択できるようにダイアログを表示するようにしています。
また、API ShellExecute の処理を1つの標準モジュール「API利用」にまとめています。

標準モジュール「API利用」への記述内容
Type tagOPENFILENAME
  lStructSize As Long
  hwndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustFilter As Long
  nFilterIndex As Long
  lpstrFile As String
  nMaxFile As Long
  lpstrFileTitle As String
  nMaxFileTitle As Long
  lpstrInitialDir As String
  lpstrTitle As String
  flags As Long
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type

Declare Function apiGetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (OPENFILENAME As tagOPENFILENAME) As Long

Declare Function apiShellExecute 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

Const SW_SHOWNORMAL = 1   ' 正常


Public Function appFileNameGet(hwnd As Long, sTitle As String, sFullPath As String, sFileName As String) As Boolean
  Dim tagOfn As tagOPENFILENAME
  Dim sTmp As String
  Dim LRet As Long
  Dim bTmp As Boolean

  sTmp = ""
  sTmp = sTmp & "すべてのファイル(*.*)" & vbNullChar
  sTmp = sTmp & "*.*" & vbNullChar
  sTmp = sTmp & vbNullChar

  tagOfn.hwndOwner = hwnd
  tagOfn.lpstrFilter = sTmp
  tagOfn.lpstrFile = String(512, vbNullChar)
  tagOfn.nMaxFile = 511
  tagOfn.lpstrFileTitle = String(512, vbNullChar)
  tagOfn.nMaxFileTitle = 511
  tagOfn.lpstrInitialDir = ""
  tagOfn.lpstrTitle = sTitle
  tagOfn.lpstrDefExt = ""
  tagOfn.lStructSize = Len(tagOfn)

  bTmp = False
  LRet = apiGetOpenFileName(tagOfn)
  If (LRet <> 0) Then
    sFullPath = Left(tagOfn.lpstrFile, InStr(tagOfn.lpstrFile, vbNullChar) - 1)
    sFileName = Left(tagOfn.lpstrFileTitle, InStr(tagOfn.lpstrFileTitle, vbNullChar) - 1)
    bTmp = True
  End If

  appFileNameGet = bTmp
End Function

Public Sub appShellExecute(sPath As String)
  Call apiShellExecute(0, "OPEN", sPath, "", "", SW_SHOWNORMAL)
End Sub

 
私の場合、APIを利用する際には、
Declare 宣言では、関数の先頭に api を付加 (& Private 宣言) (省略時は Public ?)
直接呼ばせたくないので、いつもは Private 記述しているんですが、、、今回抜け。
各APIを使用する時には、関数を1つかまし(ここでは関数先頭に app 付加)、
APIを使わなく、、、とか、他の方法に切り替え、、、って言った場合
app で始まる関数内部を書き換えればよいだけなので、後々楽?程度のルールにしてます。
(パラメータを増やさないといけない場合は例外になりますが)


こういった起動の時、セキュリティの設定で
開いても良い??云々のメッセージに出くわす場合があります。
私は「低」にして、やたらに何でも起動することはしていないので、めったに遭遇はしません。
(ハイパーリンクではなく、API ShellExecute を使っていることもあり?)

起動対象が Access mdb であった場合、入手経路/置き場所等でメッセージが出ることがあります。
あんたは誰?ってな感じでしょうか。

デジタル署名について
http://office.microsoft.com/ja-jp/access/HP010397921041.aspx

の後半に記述されている(AutomationSecurity プロパティをいじる)
VBSファイル云々で回避できるようですが、注意事項があり、、、理解できてません。

やってみると、あ~動くね、ってことで。

上記URLで紹介されている内容を、直にVBAで記述してファイル名を変えながらの起動で良いかも?。
中に組み込むのもなんだかな?っていう時のことを考えてみました。

起動する mdb 毎にVBSファイルを用意する方法になりますが、
上記URL VBSサンプルのファイル名を変えたものを作ります。(先頭1行のみ変更)

で、そのVBSを指定した起動を行います。
起動には、Shell.Application / API ShellExecute を使います。
(この方法で、メッセージなく起動されることは確認できました)

ただ、VBSを起動する時にハイパーリンク/FollowHyperlink で起動すると、
VISTA+Access 2007 では、今度は VBS を云々のメッセージが出るようになります。

組み込むのも、外に置いて実現するのも方針によるものになりますか???


※ ただ単にメッセージが出る状態のものを見つけて、
  それに対して確認したものになるので、他の条件のもので、できるものなのかは???

※ テキスト部分に、ファイル名、http、フォルダまでのパス等など入力してみて
  いろいろな起動を試してみてください。


サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kSample93_2000.zipkSample93_2003.zipkSample93_2007.zip
 サイズ 35,12136,41038,746
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化

追記)
※ 私の中で、ハイパーリンク/FollowHyperlink を使用しない大きな要因は、
  起動したアプリケーションのツールバー表示に、  webツールバーが表示されるかどうか、でした。
  ハイパーリンク/FollowHyperlink では、webツールバーが表示され、邪魔だったので。
  (例えば、エクセルファイルを指定した起動などで)

  ただ、2007になってリボンになると、違和感は薄らぎましたが、、、

関連記事

2011/07/10

Category: サンプルかな

TB: 0  /  CM: 0

top △

この記事に対するコメント

top △

コメントの投稿

Secret

top △

トラックバック

トラックバックURL
→http://kikutips.blog13.fc2.com/tb.php/93-6f427b77
この記事にトラックバックする(FC2ブログユーザー)

top △


上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。